?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE:  Object Library Generator' ??
MODULE ocm$generate;

{ PURPOSE:
{   To initiate the generation of the
{   output library pursuant to the
{   previously issued commands.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_command_processing
*copyc cyd$run_time_error_condition
*copyc llt$deferred_common_blocks
*copyc llt$deferred_entry_points
*copyc llt$load_module
*copyc llt$obsolete_formal_parameters
*copyc oce$format_not_allowed_with_nl
*copyc oce$generate_not_complete
*copyc oce$library_generator_errors
*copyc oct$actual_parameter_list
*copyc oct$display_toggles
*copyc oct$entry_point_sorted_list
*copyc oct$load_module_list
*copyc oct$separated_components
*copyc oss$job_paged_literal
?? POP ??
*copyc amp$get_segment_pointer
*copyc amp$set_segment_eoi
*copyc clp$convert_integer_to_string
*copyc clp$evaluate_parameters
*copyc clp$extract_message_module
*copyc clp$extract_scl_procedure
*copyc clp$get_message_module_info
*copyc fdp$generate_form_module
*copyc fdp$generate_form_variable
*copyc fsp$close_file
*copyc fsp$open_file
*copyc i#current_sequence_position
*copyc i#move
*copyc mmp$advise_out
*copyc mmp$create_scratch_segment
*copyc mmp$create_user_segment
*copyc mmp$delete_scratch_segment
*copyc mmp$preset_page_streaming
*copyc mmp$set_access_selections
*copyc ocp$add_additions_to_nlm_list
*copyc ocp$build_file_dir_from_temp
*copyc ocp$build_library_directory
*copyc ocp$close_all_open_files
*copyc ocp$close_output_file
*copyc ocp$convert_information_element
*copyc ocp$create_an_nlm
*copyc ocp$generate_message
*copyc ocp$initialize_olg_working_heap
*copyc ocp$open_output_file
*copyc ocp$output
*copyc ocp$output_date
*copyc ocp$output_section_kind
*copyc ocp$output_time
*copyc ocp$return_files
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc osp$set_status_from_condition
*copyc pmp$continue_to_cause
*copyc pmp$disestablish_cond_handler
*copyc pmp$establish_condition_handler
*copyc pmp$get_page_size
*copyc pmp$position_object_library
*copyc syp$advised_move_bytes
*copyc ocv$nlm_list
*copyc ocv$olg_scratch_seq
*copyc ocv$olg_working_heap
*copyc ocv$open_file_list
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  VAR
    command_status: ost$status,
    object_type_checking: [STATIC, READ] string (6) := 'OBJECT';

?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$generate', EJECT ??

  PROCEDURE [XDCL] ocp$generate
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

    CONST
      c$spd = osc$status_parameter_delimiter;

    TYPE
      oct$q_field = packed record
        q: -7fff(16) .. 7fff(16),
      recend;

    VAR
      working_segments_open: [STATIC] boolean := FALSE,
      segment_1: [STATIC] ^SEQ ( * ), { separated_components,  entry_point_address_list, BTIs }
      segment_2: [STATIC] ^SEQ ( * ), { TEXs, RPLs, BITs }
      segment_3: [STATIC] ^SEQ ( * ), { ADRs, EXTs }
      segment_4: [STATIC] ^SEQ ( * ), { EPTs }
      segment_5: [STATIC] ^SEQ ( * ); { SDCs, ASDS }

    VAR
      preset_segment: [STATIC] array [pmt$initialization_value] of amt$segment_pointer :=
            [REP ($INTEGER (UPPERVALUE (pmt$initialization_value)) + 1) of [amc$sequence_pointer, NIL]];

?? NEWTITLE := 'initialize_working_segments', EJECT ??

    PROCEDURE initialize_working_segments
      (VAR status: ost$status);


      VAR
        preset_value: pmt$initialization_value,
        segment_pointer: amt$segment_pointer;

      status.normal := TRUE;
      IF NOT working_segments_open THEN
        mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, segment_pointer, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        segment_1 := segment_pointer.sequence_pointer;

        mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, segment_pointer, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        segment_2 := segment_pointer.sequence_pointer;

        mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, segment_pointer, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        segment_3 := segment_pointer.sequence_pointer;

        mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, segment_pointer, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        segment_4 := segment_pointer.sequence_pointer;

        mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, segment_pointer, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        segment_5 := segment_pointer.sequence_pointer;
        working_segments_open := TRUE;
      IFEND;

      RESET segment_1;
      RESET segment_2;
      RESET segment_3;
      RESET segment_4;
      RESET segment_5;

{ If any of the preset segments still exist, remove them.  We need new, uncorrupted
{ segments to generate another library.  These will be created as needed.

      FOR preset_value := LOWERVALUE (pmt$initialization_value) TO UPPERVALUE (pmt$initialization_value) DO
        IF preset_segment [preset_value].sequence_pointer <> NIL THEN
          mmp$delete_scratch_segment (preset_segment [preset_value], {ignore} status);
          preset_segment [preset_value].sequence_pointer := NIL;
        IFEND;
        status.normal := TRUE;
      FOREND;

    PROCEND initialize_working_segments;
?? OLDTITLE ??
?? NEWTITLE := 'generate_scl_proc_file', EJECT ??

    PROCEDURE generate_scl_proc_file
      (    file: fst$file_reference;
       VAR status: ost$status);

      VAR
        nlm: ^oct$new_library_module_list,
        file_id: amt$file_identifier,
        scl_procedure_header: ^llt$library_member_header,
        alias_list: ^pmt$module_list,
        scl_procedure: ^SEQ ( * ),
        sequence: ^SEQ ( * ),
        ignore_status: ost$status,
        attachment_options: array [1 .. 3] of fst$attachment_option,
        default_creation_attributes: array [1 .. 2] of fst$file_cycle_attribute,
        validation_attributes: array [1 .. 5] of fst$file_cycle_attribute;


      validation_attributes [1].selector := fsc$file_contents_and_processor;
      validation_attributes [1].file_contents := fsc$legible_scl_procedure;
      validation_attributes [1].file_processor := osc$null_name;
      validation_attributes [2].selector := fsc$file_contents_and_processor;
      validation_attributes [2].file_contents := fsc$legible_data;
      validation_attributes [2].file_processor := osc$null_name;
      validation_attributes [3].selector := fsc$file_contents_and_processor;
      validation_attributes [3].file_contents := amc$legible;
      validation_attributes [3].file_processor := osc$null_name;
      validation_attributes [4].selector := fsc$file_contents_and_processor;
      validation_attributes [4].file_contents := fsc$data;
      validation_attributes [4].file_processor := osc$null_name;
      validation_attributes [5].selector := fsc$file_contents_and_processor;
      validation_attributes [5].file_contents := fsc$unknown_contents;
      validation_attributes [5].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$append, fsc$shorten];
      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$access_and_share_modes;
      attachment_options [2].access_modes.selector := fsc$specific_access_modes;
      attachment_options [2].access_modes.value := $fst$file_access_options [fsc$append];
      attachment_options [2].share_modes.selector := fsc$specific_share_modes;
      attachment_options [2].share_modes.value := $fst$file_access_options [];
      attachment_options [3].selector := fsc$open_share_modes;
      attachment_options [3].open_share_modes := -$fst$file_access_options [];
      default_creation_attributes [1].selector := fsc$file_contents_and_processor;
      default_creation_attributes [1].file_contents := fsc$legible_scl_procedure;
      default_creation_attributes [1].file_processor := osc$null_name;
      default_creation_attributes [2].selector := fsc$page_format;
      default_creation_attributes [2].page_format := amc$untitled_form;
      fsp$open_file (file, amc$record, ^attachment_options, ^default_creation_attributes, NIL,
            ^validation_attributes, NIL, file_id, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      nlm := ocv$nlm_list^.f_link;

      REPEAT
        IF (nlm^.description^.kind = occ$command_procedure) OR
              (nlm^.description^.kind = occ$applic_command_procedure) OR
              (nlm^.description^.kind = occ$function_procedure) THEN
          IF (nlm^.description^.kind = occ$applic_command_procedure) THEN
            scl_procedure_header := ^nlm^.description^.applic_command_procedure_header^.library_member_header;
          ELSE
            scl_procedure_header := nlm^.description^.command_procedure_header;
          IFEND;

          sequence := #PTR (scl_procedure_header^.member, nlm^.description^.file^);
          IF sequence = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, nlm^.name, status);
            RETURN;
          IFEND;

          RESET sequence;

          NEXT scl_procedure: [[REP scl_procedure_header^.member_size OF cell]] IN sequence;
          IF scl_procedure = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, nlm^.name, status);
            RETURN;
          IFEND;

          clp$extract_scl_procedure (file_id, scl_procedure, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;

        nlm := nlm^.f_link;
      UNTIL nlm^.name = osc$null_name;


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

    PROCEND generate_scl_proc_file;
?? OLDTITLE ??
?? NEWTITLE := 'generate_message_module_file', EJECT ??

    PROCEDURE generate_message_module_file
      (    file: fst$file_reference;
       VAR status: ost$status);

      VAR
        nlm: ^oct$new_library_module_list,
        file_id: amt$file_identifier,
        message_module_header: ^llt$library_member_header,
        message_module: ^SEQ ( * ),
        sequence: ^SEQ ( * ),
        ignore_status: ost$status,
        attachment_options: array [1 .. 3] of fst$attachment_option,
        default_creation_attributes: array [1 .. 2] of fst$file_cycle_attribute,
        validation_attributes: array [1 .. 5] of fst$file_cycle_attribute;


      validation_attributes [1].selector := fsc$file_contents_and_processor;
      validation_attributes [1].file_contents := fsc$legible_scl_include;
      validation_attributes [1].file_processor := osc$null_name;
      validation_attributes [2].selector := fsc$file_contents_and_processor;
      validation_attributes [2].file_contents := fsc$legible_data;
      validation_attributes [2].file_processor := osc$null_name;
      validation_attributes [3].selector := fsc$file_contents_and_processor;
      validation_attributes [3].file_contents := amc$legible;
      validation_attributes [3].file_processor := osc$null_name;
      validation_attributes [4].selector := fsc$file_contents_and_processor;
      validation_attributes [4].file_contents := fsc$data;
      validation_attributes [4].file_processor := osc$null_name;
      validation_attributes [5].selector := fsc$file_contents_and_processor;
      validation_attributes [5].file_contents := fsc$unknown_contents;
      validation_attributes [5].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$append, fsc$shorten];
      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$access_and_share_modes;
      attachment_options [2].access_modes.selector := fsc$specific_access_modes;
      attachment_options [2].access_modes.value := $fst$file_access_options [fsc$append];
      attachment_options [2].share_modes.selector := fsc$specific_share_modes;
      attachment_options [2].share_modes.value := $fst$file_access_options [];
      attachment_options [3].selector := fsc$open_share_modes;
      attachment_options [3].open_share_modes := -$fst$file_access_options [];
      default_creation_attributes [1].selector := fsc$file_contents_and_processor;
      default_creation_attributes [1].file_contents := fsc$legible_scl_include;
      default_creation_attributes [1].file_processor := osc$null_name;
      default_creation_attributes [2].selector := fsc$page_format;
      default_creation_attributes [2].page_format := amc$untitled_form;
      fsp$open_file (file, amc$record, ^attachment_options, ^default_creation_attributes, NIL,
            ^validation_attributes, NIL, file_id, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      nlm := ocv$nlm_list^.f_link;

      REPEAT
        IF nlm^.description^.kind = occ$message_module THEN
          message_module_header := nlm^.description^.message_module_header;

          sequence := #PTR (message_module_header^.member, nlm^.description^.file^);
          IF sequence = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, nlm^.name, status);
            RETURN;
          IFEND;

          RESET sequence;
          NEXT message_module: [[REP message_module_header^.member_size OF cell]] IN sequence;
          IF message_module = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, nlm^.name, status);
            RETURN;
          IFEND;

          clp$extract_message_module (file_id, message_module_header^.name, message_module, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;

        nlm := nlm^.f_link;
      UNTIL nlm^.name = osc$null_name;


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

    PROCEND generate_message_module_file;
?? OLDTITLE ??
?? NEWTITLE := 'generate_form_source_file', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to generate a file containing all
{   the form modules on the current library.

    PROCEDURE generate_form_source_file
      (    file: fst$file_reference;
       VAR status: ost$status);

      VAR
        attachment_options: array [1 .. 3] of fst$attachment_option,
        default_creation_attributes: array [1 .. 2] of fst$file_cycle_attribute,
        file_id: amt$file_identifier,
        form_module_header_p: ^llt$library_member_header,
        form_module_p: ^fdt$form_module,
        form_module_sequence_p: ^SEQ ( * ),
        ignore_status: ost$status,
        nlm_p: ^oct$new_library_module_list,
        validation_attributes: array [1 .. 5] of fst$file_cycle_attribute;


      validation_attributes [1].selector := fsc$file_contents_and_processor;
      validation_attributes [1].file_contents := fsc$legible_scl_include;
      validation_attributes [1].file_processor := osc$null_name;
      validation_attributes [2].selector := fsc$file_contents_and_processor;
      validation_attributes [2].file_contents := fsc$legible_data;
      validation_attributes [2].file_processor := osc$null_name;
      validation_attributes [3].selector := fsc$file_contents_and_processor;
      validation_attributes [3].file_contents := amc$legible;
      validation_attributes [3].file_processor := osc$null_name;
      validation_attributes [4].selector := fsc$file_contents_and_processor;
      validation_attributes [4].file_contents := fsc$data;
      validation_attributes [4].file_processor := osc$null_name;
      validation_attributes [5].selector := fsc$file_contents_and_processor;
      validation_attributes [5].file_contents := fsc$unknown_contents;
      validation_attributes [5].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$append, fsc$shorten];
      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$access_and_share_modes;
      attachment_options [2].access_modes.selector := fsc$specific_access_modes;
      attachment_options [2].access_modes.value := $fst$file_access_options [fsc$append];
      attachment_options [2].share_modes.selector := fsc$specific_share_modes;
      attachment_options [2].share_modes.value := $fst$file_access_options [];
      attachment_options [3].selector := fsc$open_share_modes;
      attachment_options [3].open_share_modes := -$fst$file_access_options [];
      default_creation_attributes [1].selector := fsc$file_contents_and_processor;
      default_creation_attributes [1].file_contents := fsc$legible_scl_include;
      default_creation_attributes [1].file_processor := osc$null_name;
      default_creation_attributes [2].selector := fsc$page_format;
      default_creation_attributes [2].page_format := amc$untitled_form;
      fsp$open_file (file, amc$record, ^attachment_options, ^default_creation_attributes, NIL,
            ^validation_attributes, NIL, file_id, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      nlm_p := ocv$nlm_list^.f_link;

      REPEAT
        IF nlm_p^.description^.kind = occ$panel_module THEN
          form_module_header_p := nlm_p^.description^.panel_module_header;

          form_module_sequence_p := #PTR (form_module_header_p^.member, nlm_p^.description^.file^);
          IF form_module_sequence_p = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, nlm_p^.name, status);
            fsp$close_file (file_id, ignore_status);
            RETURN;
          IFEND;

          RESET form_module_sequence_p;
          NEXT form_module_p: [[REP form_module_header_p^.member_size OF cell]] IN form_module_sequence_p;
          IF form_module_p = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, nlm_p^.name, status);
            fsp$close_file (file_id, ignore_status);
            RETURN;
          IFEND;

          fdp$generate_form_module (file_id, form_module_header_p^.name, form_module_p, status);
          IF NOT status.normal THEN
            fsp$close_file (file_id, ignore_status);
            RETURN;
          IFEND;
        IFEND;

        nlm_p := nlm_p^.f_link;
      UNTIL nlm_p^.name = osc$null_name;

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

    PROCEND generate_form_source_file;
?? OLDTITLE ??
?? NEWTITLE := 'generate_form_variable_file', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to generate a file containing all
{   the form variables for every form module on the current library.

    PROCEDURE generate_form_variable_file
      (    file: fst$file_reference;
       VAR status: ost$status);

      VAR
        attachment_options: array [1 .. 3] of fst$attachment_option,
        default_creation_attributes: array [1 .. 2] of fst$file_cycle_attribute,
        file_id: amt$file_identifier,
        form_module_header_p: ^llt$library_member_header,
        form_module_p: ^fdt$form_module,
        form_module_sequence_p: ^SEQ ( * ),
        ignore_status: ost$status,
        nlm_p: ^oct$new_library_module_list,
        validation_attributes: array [1 .. 1] of fst$file_cycle_attribute;


      validation_attributes [1].selector := fsc$file_contents_and_processor;
      validation_attributes [1].file_contents := fsc$legible_data;
      validation_attributes [1].file_processor := fsc$scu;
      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$append, fsc$shorten];
      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$access_and_share_modes;
      attachment_options [2].access_modes.selector := fsc$specific_access_modes;
      attachment_options [2].access_modes.value := $fst$file_access_options [fsc$append];
      attachment_options [2].share_modes.selector := fsc$specific_share_modes;
      attachment_options [2].share_modes.value := $fst$file_access_options [];
      attachment_options [3].selector := fsc$open_share_modes;
      attachment_options [3].open_share_modes := -$fst$file_access_options [];
      default_creation_attributes [1].selector := fsc$file_contents_and_processor;
      default_creation_attributes [1].file_contents := fsc$legible_data;
      default_creation_attributes [1].file_processor := fsc$scu;
      default_creation_attributes [2].selector := fsc$page_format;
      default_creation_attributes [2].page_format := amc$untitled_form;
      fsp$open_file (file, amc$record, ^attachment_options, ^default_creation_attributes, NIL,
            ^validation_attributes, NIL, file_id, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      nlm_p := ocv$nlm_list^.f_link;

      REPEAT
        IF nlm_p^.description^.kind = occ$panel_module THEN
          form_module_header_p := nlm_p^.description^.panel_module_header;

          form_module_sequence_p := #PTR (form_module_header_p^.member, nlm_p^.description^.file^);
          IF form_module_sequence_p = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, nlm_p^.name, status);
            fsp$close_file (file_id, ignore_status);
            RETURN;
          IFEND;

          RESET form_module_sequence_p;
          NEXT form_module_p: [[REP form_module_header_p^.member_size OF cell]] IN form_module_sequence_p;
          IF form_module_p = NIL THEN
            osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, nlm_p^.name, status);
            fsp$close_file (file_id, ignore_status);
            RETURN;
          IFEND;

          fdp$generate_form_variable (file_id, form_module_header_p^.name, form_module_p, status);
          IF NOT status.normal THEN
            fsp$close_file (file_id, ignore_status);
            RETURN;
          IFEND;
        IFEND;

        nlm_p := nlm_p^.f_link;
      UNTIL nlm_p^.name = osc$null_name;


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

    PROCEND generate_form_variable_file;
?? OLDTITLE ??
?? NEWTITLE := 'generate_object_file', EJECT ??

    PROCEDURE generate_object_file
      (    format: clt$keyword;
           library_value: clt$data_value;
       VAR status: ost$status);

?? NEWTITLE := '      COPY_CPU_OBJECT_MODULE' ??
?? EJECT ??

      PROCEDURE [XREF] copy_cpu_object_module
        (    module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR temporary_object_file: ^SEQ ( * );
         VAR status: ost$status);

?? OLDTITLE ??
?? NEWTITLE := '      COPY_PPU_OBJECT_MODULE' ??
?? EJECT ??

      PROCEDURE [XREF] copy_ppu_object_module
        (    module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR object_text_descriptor: ^llt$object_text_descriptor;
         VAR temporary_object_file: ^SEQ ( * );
         VAR status: ost$status);

?? OLDTITLE ??
?? NEWTITLE := '      COPY_LOAD_MODULE' ??
?? EJECT ??

      PROCEDURE [XREF] copy_load_module
        (    module_index: llt$module_index;
             module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR new_load_module_header: ^llt$load_module_header;
         VAR new_code_section: ^cell;
         VAR new_read_section: ^cell;
         VAR temporary_library: ^SEQ ( * );
         VAR status: ost$status);


?? OLDTITLE ??
?? NEWTITLE := '      COPY_LOAD_TO_OBJECT_MODULE' ??
?? EJECT ??

      PROCEDURE [XREF] copy_load_to_object_module
        (    module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR temporary_library: ^SEQ ( * );
         VAR status: ost$status);


?? OLDTITLE ??
?? NEWTITLE := '      COPY_TEMPORARY_LOAD_MODULE' ??
?? EJECT ??

      PROCEDURE [XREF] copy_temporary_load_module
        (    module_index: llt$module_index;
             module_description: ^oct$module_description;
         VAR load_module_header: ^llt$load_module_header;
         VAR code_section: ^cell;
         VAR read_section: ^cell;
         VAR temporary_library: ^SEQ ( * );
         VAR status: ost$status);

?? OLDTITLE ??
?? NEWTITLE := '      COPY_PROGRAM_DESCRIPTION' ??
?? EJECT ??

      PROCEDURE [XREF] copy_program_description
        (    module_index: llt$module_index;
             module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR new_program_description_header: ^llt$library_member_header;
         VAR temporary_library: ^SEQ ( * );
         VAR status: ost$status);

?? OLDTITLE ??
?? NEWTITLE := '      COPY_SCL_PROCEDURE' ??
?? EJECT ??

      PROCEDURE [XREF] copy_scl_procedure
        (    module_index: llt$module_index;
             module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR new_scl_procedure_header: ^llt$library_member_header;
         VAR temporary_library: ^SEQ ( * );
         VAR status: ost$status);

?? OLDTITLE ??
?? NEWTITLE := '      COPY_COMMAND_DESCRIPTION' ??
?? EJECT ??

      PROCEDURE [XREF] copy_command_description
        (    module_index: llt$module_index;
             module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR new_command_description_header: ^llt$library_member_header;
         VAR temporary_library: ^SEQ ( * );
         VAR status: ost$status);

?? OLDTITLE ??
?? NEWTITLE := '      COPY_FUNCTION_DESCRIPTION' ??
?? EJECT ??

      PROCEDURE [XREF] copy_function_description
        (    module_index: llt$module_index;
             module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR new_function_description_header: ^llt$library_member_header;
         VAR temporary_library: ^SEQ ( * );
         VAR status: ost$status);

?? OLDTITLE ??
?? NEWTITLE := '      COPY_APPLIC_PROGRAM_DESCRIPTION' ??
?? EJECT ??

      PROCEDURE [XREF] copy_applic_program_description
        (    module_index: llt$module_index;
             module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR new_applic_program_description: ^llt$application_member_header;
         VAR temporary_library: ^SEQ ( * );
         VAR status: ost$status);

?? OLDTITLE ??
?? NEWTITLE := '      COPY_APPLIC_COMMAND_PROCEDURE' ??
?? EJECT ??

      PROCEDURE [XREF] copy_applic_command_procedure
        (    module_index: llt$module_index;
             module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR new_applic_command_procedure: ^llt$application_member_header;
         VAR temporary_library: ^SEQ ( * );
         VAR status: ost$status);

?? OLDTITLE ??
?? NEWTITLE := '      COPY_APPLIC_COMMAND_DESCRIPTION' ??
?? EJECT ??

      PROCEDURE [XREF] copy_applic_command_description
        (    module_index: llt$module_index;
             module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR new_applic_command_description: ^llt$application_member_header;
         VAR temporary_library: ^SEQ ( * );
         VAR status: ost$status);

?? OLDTITLE ??
?? NEWTITLE := '      COPY_APP_PROG_DES_TO_PROG_DES' ??
?? EJECT ??

      PROCEDURE [XREF] copy_app_prog_des_to_prog_des
        (    module_index: llt$module_index;
             module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR new_program_description_header: ^llt$library_member_header;
         VAR temporary_library: ^SEQ ( * );
         VAR status: ost$status);

?? OLDTITLE ??
?? NEWTITLE := '      COPY_APP_SCL_PROC_TO_SCL_PROC' ??
?? EJECT ??

      PROCEDURE [XREF] copy_app_scl_proc_to_scl_proc
        (    module_index: llt$module_index;
             module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR new_scl_procedure_header: ^llt$library_member_header;
         VAR temporary_library: ^SEQ ( * );
         VAR status: ost$status);

?? OLDTITLE ??
?? NEWTITLE := '      COPY_APP_CMND_DES_TO_CMND_DES' ??
?? EJECT ??

      PROCEDURE [XREF] copy_app_cmnd_des_to_cmnd_des
        (    module_index: llt$module_index;
             module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR new_command_description_header: ^llt$library_member_header;
         VAR temporary_library: ^SEQ ( * );
         VAR status: ost$status);

?? OLDTITLE ??
?? NEWTITLE := '      COPY_PROG_DES_TO_APP_PROG_DES' ??
?? EJECT ??

      PROCEDURE [XREF] copy_prog_des_to_app_prog_des
        (    module_index: llt$module_index;
             module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR new_applic_program_description: ^llt$application_member_header;
         VAR temporary_library: ^SEQ ( * );
         VAR status: ost$status);

?? OLDTITLE ??
?? NEWTITLE := '      COPY_SCL_PROC_TO_APP_SCL_PROC' ??
?? EJECT ??

      PROCEDURE [XREF] copy_scl_proc_to_app_scl_proc
        (    module_index: llt$module_index;
             module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR new_applic_command_procedure: ^llt$application_member_header;
         VAR temporary_library: ^SEQ ( * );
         VAR status: ost$status);

?? OLDTITLE ??
?? NEWTITLE := '      COPY_CMND_DES_TO_APP_CMND_DES' ??
?? EJECT ??

      PROCEDURE [XREF] copy_cmnd_des_to_app_cmnd_des
        (    module_index: llt$module_index;
             module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR new_applic_command_description: ^llt$application_member_header;
         VAR temporary_library: ^SEQ ( * );
         VAR status: ost$status);

?? OLDTITLE ??
?? NEWTITLE := '      COPY_MESSAGE_MODULE' ??
?? EJECT ??

      PROCEDURE [XREF] copy_message_module
        (    module_index: llt$module_index;
             module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR new_message_module_header: ^llt$library_member_header;
         VAR temporary_library: ^SEQ ( * );
         VAR status: ost$status);

?? OLDTITLE ??
?? NEWTITLE := '      COPY_PANEL_MODULE' ??
?? EJECT ??

      PROCEDURE [XREF] copy_panel_module
        (    module_index: llt$module_index;
             module_description: ^oct$module_description;
             changed_info: ^oct$changed_info;
         VAR new_panel_module_header: ^llt$library_member_header;
         VAR temporary_library: ^SEQ ( * );
         VAR status: ost$status);

?? OLDTITLE ??
?? NEWTITLE := '    GENERATE_TEMPORARY_OBJECT_FILE' ??
?? EJECT ??

      PROCEDURE generate_temporary_object_file
        (VAR temporary_object_file: ^SEQ ( * );
         VAR status: ost$status);



        VAR
          local_status: ost$status,
          object_text_descriptor: ^llt$object_text_descriptor,

          nlm: ^oct$new_library_module_list;


        local_status.normal := TRUE;

        RESET temporary_object_file;
        nlm := ocv$nlm_list^.f_link;

        REPEAT
          CASE nlm^.description^.kind OF
          = occ$cpu_object_module =
            copy_cpu_object_module (nlm^.description, nlm^.changed_info, temporary_object_file, local_status);

          = occ$load_module =
            copy_load_to_object_module (nlm^.description, nlm^.changed_info, temporary_object_file,
                  local_status);

          = occ$ppu_object_module =
            copy_ppu_object_module (nlm^.description, nlm^.changed_info, object_text_descriptor,
                  temporary_object_file, local_status);

          ELSE
            ;
          CASEND;

          IF NOT local_status.normal THEN
            ocp$generate_message (local_status);
            osp$set_status_abnormal (oc, oce$w_new_file_not_generated, '', status);
          IFEND;

          nlm := nlm^.f_link;

        UNTIL nlm^.name = osc$null_name;


      PROCEND generate_temporary_object_file;
?? OLDTITLE ??
?? NEWTITLE := '      GENERATE_TEMPORARY_LIBRARY_FILE' ??
?? EJECT ??

      PROCEDURE generate_temporary_library_file
        (VAR temporary_library_file: ^SEQ ( * );
         VAR status: ost$status);

?? NEWTITLE := '        BUILD_LOAD_MODULE_LIST' ??
?? EJECT ??

        PROCEDURE build_load_module_list
          (    nlm_list: ^oct$new_library_module_list;
           VAR load_module_list: oct$load_module_list;
           VAR status: ost$status);

?? NEWTITLE := '          BUILD_TEMPORARY_LOAD_MODULE' ??
?? EJECT ??

          PROCEDURE build_temporary_load_module
            (    module_description: ^oct$module_description;
                 changed_info: ^oct$changed_info;
             VAR temporary_load_module: ^oct$module_description;
             VAR status: ost$status);





            VAR
              quick_bind: boolean,
              ocv$binding_section: ^oct$section_definition_list;

?? NEWTITLE := '            CHANGE_BOUND_TO_TEMP_MODULE' ??
?? EJECT ??

            PROCEDURE change_bound_to_temp_module
              (VAR bound_module: oct$bound_module_header;
                   changed_info: ^oct$changed_info;
               VAR temporary_module_header: ^oct$temporary_module_header;
               VAR status: ost$status);

?? NEWTITLE := '              CHECK_SECTION_ORDINAL_&_OFFSET', EJECT ??

              PROCEDURE [INLINE] check_section_ordinal_offset
                (    section_ordinal: llt$section_ordinal;
                     section_offset: ost$segment_offset;
                     section_definitions: ^oct$section_definitions;
                     module_name: pmt$program_name;
                 VAR status: ost$status);


                IF section_ordinal > UPPERBOUND (section_definitions^) THEN
                  osp$set_status_abnormal (oc, oce$e_invalid_section_ordinal, module_name, status);
                  RETURN;
                IFEND;

                IF section_definitions^ [section_ordinal] = NIL THEN
                  osp$set_status_abnormal (oc, oce$e_section_not_yet_defined, module_name, status);
                  RETURN;
                IFEND;

                IF section_offset > section_definitions^ [section_ordinal]^.section_definition.length THEN
                  osp$set_status_abnormal (oc, oce$e_reference_outside_section, module_name, status);
                  RETURN;
                IFEND;


              PROCEND check_section_ordinal_offset;
?? OLDTITLE ??
?? NEWTITLE := '              RELOCATED_SECTION_ORDINAL' ??
?? NEWTITLE := '              RELOCATED_SECTION_OFFSET', EJECT ??

              PROCEDURE [INLINE] relocated_section_ordinal
                (    component: oct$separated_module_header;
                     old_section_ordinal: llt$section_ordinal;
                 VAR new_section_ordinal: llt$section_ordinal);


                new_section_ordinal := component.section_definitions^ [old_section_ordinal]^.new^.
                      section_definition.section_ordinal;


              PROCEND relocated_section_ordinal;



              FUNCTION relocated_section_offset
                (    component: oct$separated_module_header;
                     old_section_ordinal: llt$section_ordinal;
                     old_section_offset: ost$segment_offset): ost$segment_offset;


                relocated_section_offset := component.section_definitions^ [old_section_ordinal]^.
                      new_section_offset + old_section_offset;


              FUNCEND relocated_section_offset;
?? OLDTITLE ??
?? OLDTITLE ??
?? NEWTITLE := '              ADD_TEXT_INSERTION_RECORD' ??
?? EJECT ??

{ PURPOSE:
{   This procedure inserts a text insertion record into a list.  There is a text
{   insertion list generated for each section and the records are kept in order
{   by bit offset into the section.  A text insertion record may represent a TEXT,
{   REPLICATION or BIT STRING INSERTION object text record.
{ DESIGN:
{   For each section, there is a text insertion list and two pointers into
{   the list.  One pointer points to the last text insertion record.  The
{   other pointer points to the text insertion record that was last inserted.
{   This procedure first checks to see if the text insertion record should be
{   added at the end of the list.  If it is not a search will be made
{   sequentially through the list.  If the record should come after the one that
{   was last inserted the search starts there, otherwise it will start at the
{   beginning of the list.

              PROCEDURE [INLINE] add_text_insertion_record
                (VAR last_text_insertion_record: ^oct$text_insertion_list;
                 VAR last_text_insertion_point: ^oct$text_insertion_list;
                 VAR text_insertion_records: oct$text_insertion_list;
                 VAR text_insertion_record: ^oct$text_insertion_list);


                VAR
                  next_text_record: ^oct$text_insertion_list,
                  this_text_record: ^oct$text_insertion_list,
                  tir_starting_bit_offset: integer,
                  tir_ending_bit_offset: integer;


                IF (text_insertion_record^.starting_bit_offset >
                      last_text_insertion_record^.ending_bit_offset) THEN
                  last_text_insertion_record^.link := text_insertion_record;
                  last_text_insertion_record := text_insertion_record;
                  last_text_insertion_point := text_insertion_record;
                  RETURN; {---->
                IFEND;


                tir_starting_bit_offset := text_insertion_record^.starting_bit_offset;
                tir_ending_bit_offset := text_insertion_record^.ending_bit_offset;

                IF (tir_starting_bit_offset > last_text_insertion_point^.ending_bit_offset) THEN
                  this_text_record := last_text_insertion_point;
                ELSE
                  this_text_record := ^text_insertion_records;
                IFEND;
                next_text_record := this_text_record^.link;

              /loop/
                WHILE next_text_record <> NIL DO
                  IF (NOT next_text_record^.overlapped) THEN
                    IF (next_text_record^.starting_bit_offset <= tir_ending_bit_offset) AND
                          (next_text_record^.ending_bit_offset >= tir_starting_bit_offset) THEN
                      next_text_record^.overlapped := TRUE;
                    ELSEIF tir_ending_bit_offset < next_text_record^.starting_bit_offset THEN
                      EXIT /loop/
                    IFEND;
                  IFEND;

                  this_text_record := next_text_record;
                  next_text_record := this_text_record^.link;
                WHILEND /loop/;

                text_insertion_record^.link := next_text_record;
                this_text_record^.link := text_insertion_record;
                last_text_insertion_point := text_insertion_record;
                IF text_insertion_record^.link = NIL THEN
                  last_text_insertion_record := text_insertion_record;
                IFEND;


              PROCEND add_text_insertion_record;
?? OLDTITLE ??
?? NEWTITLE := '              SEPARATE_COMPONENTS' ??
?? EJECT ??

              PROCEDURE separate_components
                (    bound_components: ^oct$bound_components;
                     debug_tables_to_omit: oct$debug_tables;
                 VAR changed_entry_points: ^oct$external_declaration_list;
                 VAR separated_components: ^oct$separated_components;
                 VAR status: ost$status);

?? NEWTITLE := '                SEPARATE_OBJECT_RECORDS' ??
?? EJECT ??

                PROCEDURE separate_object_records
                  (    module_name: pmt$program_name;
                       debug_tables_to_omit: oct$debug_tables;
                   VAR object_records: ^SEQ ( * );
                   VAR next_changed_entry_point: ^oct$external_declaration_list;
                   VAR separated_module: oct$separated_module_header;
                   VAR status: ost$status);

?? NEWTITLE := '                  ALLOCATE_SPACE_FOR_SECTION' ??
?? EJECT ??

                  PROCEDURE allocate_space_for_section
                    (    module_name: pmt$program_name;
                     VAR separated_module: oct$separated_module_header;
                     VAR section_definition: oct$section_definition;
                     VAR status: ost$status);


                    IF ((section_definition.section_definition.access_attributes *
                          $llt$section_access_attributes [llc$write,
                          llc$binding]) = $llt$section_access_attributes []) AND
                          (section_definition.section_definition.kind <> llc$extensible_working_storage) AND
                          (section_definition.section_definition.kind <> llc$common_block) AND
                          (section_definition.section_definition.kind <> llc$extensible_common_block) AND
                          (section_definition.section_definition.length <> 0) AND
                          (separated_module.header^.kind <> llc$motorola_68000) THEN

                      NEXT section_definition.text: [1 .. section_definition.section_definition.length] IN
                            segment_5;
                      IF section_definition.text = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                        RETURN;
                      IFEND;

                      section_definition.allotted_section := TRUE;
                    IFEND;


                  PROCEND allocate_space_for_section;
?? OLDTITLE ??
?? NEWTITLE := '                  ADD_TEXT_RECORD' ??
?? EJECT ??

                  PROCEDURE add_text_record
                    (VAR section_definition: oct$section_definition;
                         text: ^llt$text;
                     VAR status: ost$status);


                    VAR
                      text_insertion_record: ^oct$text_insertion_list;


                    IF section_definition.text <> NIL THEN

                      i#move (#LOC (text^.byte), #LOC (section_definition.text^ [text^.offset + 1]),
                            UPPERBOUND (text^.byte));

                    ELSE
                      NEXT text_insertion_record IN segment_2;
                      IF text_insertion_record = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                        RETURN;
                      IFEND;

                      text_insertion_record^.offset := text^.offset;
                      text_insertion_record^.bit_offset := 0;
                      text_insertion_record^.length := UPPERBOUND (text^.byte);
                      text_insertion_record^.starting_bit_offset := (text^.offset * 8);
                      text_insertion_record^.ending_bit_offset := text_insertion_record^.
                            starting_bit_offset + (text_insertion_record^.length * 8) - 1;
                      text_insertion_record^.overlapped := FALSE;

                      text_insertion_record^.kind := llc$text;
                      text_insertion_record^.text := text;
                      text_insertion_record^.link := NIL;

                      add_text_insertion_record (section_definition.last_text_insertion_record,
                            section_definition.last_text_insertion_point,
                            section_definition.text_insertion_records, text_insertion_record);
                    IFEND;


                  PROCEND add_text_record;
?? OLDTITLE ??
?? NEWTITLE := '                  ADD_REPLICATION_RECORD' ??
?? EJECT ??

                  PROCEDURE add_replication_record
                    (VAR section_definition: oct$section_definition;
                         replication: ^llt$replication;
                     VAR status: ost$status);


                    VAR
                      text_insertion_record: ^oct$text_insertion_list,
                      offset: integer,
                      i: integer;


                    IF section_definition.text <> NIL THEN
                      offset := replication^.offset + 1;
                      FOR i := 1 TO replication^.count DO
                        i#move (#LOC (replication^.byte), #LOC (section_definition.text^ [offset]),
                              UPPERBOUND (replication^.byte));
                        offset := offset + replication^.increment;
                      FOREND;

                    ELSE
                      NEXT text_insertion_record IN segment_2;
                      IF text_insertion_record = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                        RETURN;
                      IFEND;

                      text_insertion_record^.offset := replication^.offset;
                      text_insertion_record^.bit_offset := 0;
                      text_insertion_record^.length := ((replication^.count - 1) *
                            replication^.increment) + UPPERBOUND (replication^.byte);
                      text_insertion_record^.starting_bit_offset := (replication^.offset * 8);
                      text_insertion_record^.ending_bit_offset := text_insertion_record^.
                            starting_bit_offset + (text_insertion_record^.length * 8) - 1;
                      text_insertion_record^.overlapped := FALSE;

                      text_insertion_record^.kind := llc$replication;
                      text_insertion_record^.replication := replication;
                      text_insertion_record^.link := NIL;

                      add_text_insertion_record (section_definition.last_text_insertion_record,
                            section_definition.last_text_insertion_point,
                            section_definition.text_insertion_records, text_insertion_record);
                    IFEND;


                  PROCEND add_replication_record;
?? OLDTITLE ??
?? NEWTITLE := '                  ADD_BIT_STRING_INSERTION_RECORD' ??
?? EJECT ??

                  PROCEDURE add_bit_string_insertion_record
                    (VAR section_definition: oct$section_definition;
                         bit_string_insertion: ^llt$bit_string_insertion;
                     VAR status: ost$status);


                    VAR
                      text_insertion_record: ^oct$text_insertion_list,
                      bit_string: ^packed array [1 .. 70] of 0 .. 1,
                      i: 1 .. 63;


                    IF section_definition.text <> NIL THEN
                      bit_string := #LOC (section_definition.text^ [bit_string_insertion^.offset + 1]);
                      FOR i := 1 TO bit_string_insertion^.bit_length DO
                        bit_string^ [i + bit_string_insertion^.bit_offset] :=
                              bit_string_insertion^.bit_string [i];
                      FOREND;

                    ELSE
                      NEXT text_insertion_record IN segment_2;
                      IF text_insertion_record = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                        RETURN;
                      IFEND;

                      text_insertion_record^.offset := bit_string_insertion^.offset;
                      text_insertion_record^.bit_offset := bit_string_insertion^.bit_offset;
                      text_insertion_record^.length := (bit_string_insertion^.bit_offset +
                            bit_string_insertion^.bit_length + 7) DIV 8;
                      text_insertion_record^.starting_bit_offset :=
                            (8 * bit_string_insertion^.offset) + bit_string_insertion^.bit_offset;
                      text_insertion_record^.ending_bit_offset := text_insertion_record^.starting_bit_offset +
                            bit_string_insertion^.bit_length - 1;
                      text_insertion_record^.overlapped := FALSE;

                      text_insertion_record^.kind := llc$bit_string_insertion;
                      text_insertion_record^.bit_string_insertion := bit_string_insertion;
                      text_insertion_record^.link := NIL;

                      add_text_insertion_record (section_definition.last_text_insertion_record,
                            section_definition.last_text_insertion_point,
                            section_definition.text_insertion_records, text_insertion_record);
                    IFEND;


                  PROCEND add_bit_string_insertion_record;
?? OLDTITLE ??
?? EJECT ??

{ The size of the old_binding_template_list will start out at 500 and increase in increments
{ of 500 if necessary.  There is no scientific reason why 500 was chosen, it just seemed like
{ a good number.

                  CONST
                    binding_template_items = 500;

                  VAR
                    binding_template_list_size: llt$number_of_info_elements,
                    record_number: integer,
                    i: integer,
                    section_definition_length: ost$segment_length,
                    segment_length: ost$segment_length,
                    local_status: ost$status,

                    greatest_section_ordinal: integer,
                    section_ordinal: llt$section_ordinal,
                    section_offset: ost$segment_offset,
                    value_section: llt$section_ordinal,
                    dest_section: llt$section_ordinal,
                    relocating_section: llt$section_ordinal,

                    reset_value: ^SEQ ( * ),
                    valid_position: boolean,
                    allotted_section: ^llt$code_element,

                    section_definitions: ^oct$section_definitions,
                    any_obsolete_segment_defs: boolean,
                    binding_section_ordinal: llt$section_ordinal,
                    found: boolean,

                    last_library: ^oct$library_list,
                    last_entry_definition: ^oct$entry_definition_list,
                    last_address_formulation: ^^oct$address_formulation_list,
                    last_external_linkage: ^^oct$external_linkage_list,
                    last_byte_relocation: ^oct$relocation_item_list,
                    last_two_byte_relocation: ^oct$relocation_item_list,
                    last_four_byte_relocation: ^oct$relocation_item_list,
                    last_eight_byte_relocation: ^oct$relocation_item_list,
                    last_miscellaneous_record: ^oct$object_record_list,

                    binding_template_index: llt$number_of_info_elements,
                    old_binding_template_list: oct$old_binding_template_list;

                  VAR
                    object_text_descriptor: ^llt$object_text_descriptor,
                    identification: ^llt$identification,
                    application_identifier: ^llt$application_identifier,
                    libraries: ^llt$libraries,
                    section_definition: ^llt$section_definition,
                    segment_definition: ^llt$segment_definition,
                    obs_segment_definition: ^llt$obsolete_segment_definition,
                    text: ^llt$text,
                    replication: ^llt$replication,
                    bit_string_insertion: ^llt$bit_string_insertion,
                    apl: ^oct$actual_parameter_list,
                    entry_definition: ^llt$entry_definition,
                    deferred_entry_points: ^llt$deferred_entry_points,
                    entry_def: ^oct$entry_definition_list,
                    external_def: ^oct$external_linkage_list,
                    relocation: ^llt$relocation,
                    address_formulation: ^llt$address_formulation,
                    external_linkage: ^llt$external_linkage,
                    obsolete_formal_parameters: ^llt$obsolete_formal_parameters,
                    formal_parameter: ^llt$formal_parameters,
                    formal_parameters: ^llt$formal_parameters,
                    actual_parameters: ^llt$actual_parameters,
                    debug_table_fragment: ^llt$debug_table_fragment,
                    obsolete_line_address_table: ^llt$obsolete_line_address_table,
                    symbol_table: ^llt$symbol_table,
                    line_address_table: ^llt$line_address_table,
                    supplemental_debug_tables: ^llt$supplemental_debug_tables,
                    binding_template: ^llt$binding_template,
                    m68000_absolute: ^llt$68000_absolute,
                    transfer_symbol: ^llt$transfer_symbol;


                  any_obsolete_segment_defs := FALSE;

                  separated_module.file := object_records;

                  separated_module.application_identifier := NIL;

                  separated_module.library_list.link := NIL;
                  last_library := ^separated_module.library_list;

                  separated_module.relocation_list.byte.link := NIL;
                  last_byte_relocation := ^separated_module.relocation_list.byte;
                  separated_module.relocation_list.two_byte.link := NIL;
                  last_two_byte_relocation := ^separated_module.relocation_list.two_byte;
                  separated_module.relocation_list.four_byte.link := NIL;
                  last_four_byte_relocation := ^separated_module.relocation_list.four_byte;
                  separated_module.relocation_list.eight_byte.link := NIL;
                  last_eight_byte_relocation := ^separated_module.relocation_list.eight_byte;

                  separated_module.entry_definition_list.link := NIL;
                  last_entry_definition := ^separated_module.entry_definition_list;

                  separated_module.address_formulation_list := NIL;
                  last_address_formulation := ^separated_module.address_formulation_list;

                  separated_module.external_linkage_list := NIL;
                  last_external_linkage := ^separated_module.external_linkage_list;

{ The OLD_BINDING_TEMPLATE_LIST being set up here is an array where each entry represents a word in the
{ binding section (ie. entry 0 represents the first 8 bytes in the binding section, entry 1 represents
{ the second 8 bytes in the binding section, etc.).  This allows the binding template item for any
{ binding offset to be found directly by dividing the binding offset by 8 to get the index into this
{ array which contains a pointer to the binding template item.  Note that each entry in the binding
{ section is either 1 word or 2 words long and the binding offset will either be on a word boundary or
{ in the case of an internal address, the word boundary + 2.

                  binding_template_list_size := binding_template_items;

                  NEXT old_binding_template_list: [0 .. binding_template_list_size] IN ocv$olg_scratch_seq;
                  IF old_binding_template_list = NIL THEN
                    osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                    RETURN;
                  IFEND;

                  separated_module.binding_template_list := old_binding_template_list;
                  FOR i := 0 TO binding_template_list_size DO
                    old_binding_template_list^ [i].binding_template := NIL;
                  FOREND;
                  separated_module.number_of_template_items := 0;

                  separated_module.miscellaneous_record_list.link := NIL;
                  last_miscellaneous_record := ^separated_module.miscellaneous_record_list;

                  separated_module.deferred_common_blocks := NIL;
                  separated_module.deferred_entry_points := NIL;

                  separated_module.components := NIL;
                  separated_module.section_maps := NIL;

                  record_number := 1;

                  NEXT identification IN object_records;
                  IF identification = NIL THEN
                    osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                    RETURN;
                  IFEND;

                  separated_module.header := identification;

                  greatest_section_ordinal := identification^.greatest_section_ordinal;

                  NEXT separated_module.section_definitions: [0 .. greatest_section_ordinal] IN segment_1;

                  section_definitions := separated_module.section_definitions;
                  IF section_definitions = NIL THEN
                    osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                    RETURN;
                  IFEND;

                  FOR section_ordinal := 0 TO greatest_section_ordinal DO
                    section_definitions^ [section_ordinal] := NIL;
                  FOREND;

                  REPEAT
                    NEXT object_text_descriptor IN object_records;
                    IF object_text_descriptor = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                      RETURN;
                    IFEND;

                    record_number := record_number + 1;

                    CASE object_text_descriptor^.kind OF
                    = llc$identification =
                      osp$set_status_abnormal (oc, oce$e_multiple_ident_rec, module_name, status);
                      RETURN;


                    = llc$application_identifier =
                      NEXT application_identifier IN object_records;
                      IF application_identifier = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                      separated_module.application_identifier := application_identifier;

                    = llc$libraries =
                      NEXT libraries: [1 .. object_text_descriptor^.number_of_libraries] IN object_records;
                      IF libraries = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                      NEXT last_library^.link IN ocv$olg_scratch_seq;
                      last_library := last_library^.link;
                      IF last_library = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                        RETURN;
                      IFEND;

                      last_library^.link := NIL;
                      last_library^.libraries := libraries;

                    = llc$section_definition, llc$allotted_section_definition, llc$unallocated_common_block =
                      NEXT section_definition IN object_records;
                      IF section_definition = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                      section_ordinal := section_definition^.section_ordinal;
                      IF section_ordinal > greatest_section_ordinal THEN
                        osp$set_status_abnormal (oc, oce$e_invalid_section_ordinal, module_name, status);
                        RETURN;
                      IFEND;
                      IF section_definitions^ [section_ordinal] <> NIL THEN
                        osp$set_status_abnormal (oc, oce$e_duplicate_section_defn, module_name, status);
                        RETURN;
                      IFEND;
                      IF section_definition^.allocation_alignment = 0 THEN
                        osp$set_status_abnormal (oc, oce$e_zero_allocation_align, module_name, status);
                        RETURN;
                      IFEND;

                      NEXT section_definitions^ [section_ordinal] IN ocv$olg_scratch_seq;
                      IF section_definitions^ [section_ordinal] = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                        RETURN;
                      IFEND;

                      section_definitions^ [section_ordinal]^.section_definition := section_definition^;
                      section_definitions^ [section_ordinal]^.new := NIL;
                      section_definitions^ [section_ordinal]^.new_section_offset := 0;
                      section_definitions^ [section_ordinal]^.unallocated_common_block :=
                            object_text_descriptor^.kind = llc$unallocated_common_block;

                      IF (section_definitions^ [section_ordinal]^.unallocated_common_block) THEN
                        IF (section_definitions^ [section_ordinal]^.section_definition.kind <>
                              llc$common_block) AND (section_definitions^ [section_ordinal]^.
                              section_definition.kind <> llc$extensible_common_block) THEN
                          osp$set_status_abnormal (oc, oce$invalid_unalloc_common_bl, module_name, status);
                          RETURN;
                        IFEND;
                      IFEND;

                      section_definitions^ [section_ordinal]^.allotted_section := FALSE;
                      section_definitions^ [section_ordinal]^.allotted_section_length := 0;
                      section_definitions^ [section_ordinal]^.text := NIL;
                      section_definitions^ [section_ordinal]^.text_insertion_records.link := NIL;
                      section_definitions^ [section_ordinal]^.text_insertion_records.starting_bit_offset :=
                            -1;
                      section_definitions^ [section_ordinal]^.text_insertion_records.ending_bit_offset := -1;
                      section_definitions^ [section_ordinal]^.last_text_insertion_record :=
                            ^section_definitions^ [section_ordinal]^.text_insertion_records;
                      section_definitions^ [section_ordinal]^.last_text_insertion_point :=
                            ^section_definitions^ [section_ordinal]^.text_insertion_records;
                      section_definitions^ [section_ordinal]^.predefined_segment := FALSE;
                      section_definitions^ [section_ordinal]^.predefined_segment_number := 0;
                      section_definitions^ [section_ordinal]^.predefined_r1 := 0;
                      section_definitions^ [section_ordinal]^.predefined_r2 := 0;
                      section_definitions^ [section_ordinal]^.predefined_binding_ordinal := 0;
                      section_definitions^ [section_ordinal]^.predefined_binding_offset := 0;
                      section_definition_length := section_definition^.length;

                      allocate_space_for_section (module_name, separated_module,
                            section_definitions^ [section_ordinal]^, status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;

                      IF (section_definition^.kind = llc$binding_section) OR
                            (section_definition^.kind = llc$lts_reserved) THEN
                        section_definitions^ [section_ordinal]^.section_definition.name := osc$null_name;
                      IFEND;

                      IF object_text_descriptor^.kind = llc$allotted_section_definition THEN
                        reset_value := object_records;
                        pmp$position_object_library (object_records, object_text_descriptor^.allotted_section,
                              valid_position);
                        IF NOT valid_position THEN
                          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                          RETURN;
                        IFEND;

                        NEXT allotted_section: [1 .. section_definition^.length] IN object_records;
                        IF allotted_section = NIL THEN
                          osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                          RETURN;
                        IFEND;

                        IF section_definitions^ [section_ordinal]^.text = NIL THEN
                          NEXT section_definitions^ [section_ordinal]^.text:
                                [1 .. section_definition_length] IN ocv$olg_scratch_seq;
                          IF section_definitions^ [section_ordinal]^.text = NIL THEN
                            osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                            RETURN;
                          IFEND;
                        IFEND;

                        i#move (#LOC (allotted_section^), #LOC (section_definitions^ [section_ordinal]^.
                              text^), section_definition_length);

                        object_records := reset_value;
                      IFEND;

                    = llc$segment_definition =
                      NEXT segment_definition IN object_records;
                      IF segment_definition = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                      section_ordinal := segment_definition^.section_definition.section_ordinal;
                      IF section_ordinal > greatest_section_ordinal THEN
                        osp$set_status_abnormal (oc, oce$e_invalid_section_ordinal, module_name, status);
                        RETURN;
                      IFEND;
                      IF section_definitions^ [section_ordinal] <> NIL THEN
                        osp$set_status_abnormal (oc, oce$e_duplicate_section_defn, module_name, status);
                        RETURN;
                      IFEND;
                      IF segment_definition^.section_definition.allocation_alignment = 0 THEN
                        osp$set_status_abnormal (oc, oce$e_zero_allocation_align, module_name, status);
                        RETURN;
                      IFEND;

                      NEXT section_definitions^ [section_ordinal] IN ocv$olg_scratch_seq;
                      IF section_definitions^ [section_ordinal] = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                        RETURN;
                      IFEND;

                      section_definitions^ [section_ordinal]^.section_definition :=
                            segment_definition^.section_definition;
                      section_definitions^ [section_ordinal]^.new := NIL;
                      section_definitions^ [section_ordinal]^.new_section_offset := 0;
                      section_definitions^ [section_ordinal]^.unallocated_common_block := FALSE;
                      section_definitions^ [section_ordinal]^.allotted_section := FALSE;
                      section_definitions^ [section_ordinal]^.allotted_section_length := 0;
                      section_definitions^ [section_ordinal]^.text := NIL;
                      section_definitions^ [section_ordinal]^.text_insertion_records.link := NIL;
                      section_definitions^ [section_ordinal]^.text_insertion_records.starting_bit_offset :=
                            -1;
                      section_definitions^ [section_ordinal]^.text_insertion_records.ending_bit_offset := -1;
                      section_definitions^ [section_ordinal]^.last_text_insertion_record :=
                            ^section_definitions^ [section_ordinal]^.text_insertion_records;
                      section_definitions^ [section_ordinal]^.last_text_insertion_point :=
                            ^section_definitions^ [section_ordinal]^.text_insertion_records;
                      section_definitions^ [section_ordinal]^.predefined_segment := TRUE;
                      section_definitions^ [section_ordinal]^.predefined_segment_number :=
                            segment_definition^.segment_number;
                      section_definitions^ [section_ordinal]^.predefined_r1 := segment_definition^.r1;
                      section_definitions^ [section_ordinal]^.predefined_r2 := segment_definition^.r2;
                      section_definitions^ [section_ordinal]^.predefined_binding_ordinal :=
                            segment_definition^.binding_section_ordinal;
                      section_definitions^ [section_ordinal]^.predefined_binding_offset :=
                            segment_definition^.binding_section_offset;
                      section_definition_length := segment_definition^.section_definition.length;

                      allocate_space_for_section (module_name, separated_module,
                            section_definitions^ [section_ordinal]^, status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;

                      IF (segment_definition^.section_definition.kind = llc$binding_section) OR
                            (segment_definition^.section_definition.kind = llc$lts_reserved) THEN
                        section_definitions^ [section_ordinal]^.section_definition.name := osc$null_name;
                      IFEND;

                    = llc$obsolete_segment_definition =
                      NEXT obs_segment_definition IN object_records;
                      IF obs_segment_definition = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                      any_obsolete_segment_defs := TRUE;
                      segment_definition := NIL; { Trap any errors }

                      section_ordinal := obs_segment_definition^.section_definition.section_ordinal;
                      IF section_ordinal > greatest_section_ordinal THEN
                        osp$set_status_abnormal (oc, oce$e_invalid_section_ordinal, module_name, status);
                        RETURN;
                      IFEND;
                      IF section_definitions^ [section_ordinal] <> NIL THEN
                        osp$set_status_abnormal (oc, oce$e_duplicate_section_defn, module_name, status);
                        RETURN;
                      IFEND;
                      IF obs_segment_definition^.section_definition.allocation_alignment = 0 THEN
                        osp$set_status_abnormal (oc, oce$e_zero_allocation_align, module_name, status);
                        RETURN;
                      IFEND;

                      NEXT section_definitions^ [section_ordinal] IN ocv$olg_scratch_seq;
                      IF section_definitions^ [section_ordinal] = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                        RETURN;
                      IFEND;

                      section_definitions^ [section_ordinal]^.section_definition :=
                            obs_segment_definition^.section_definition;
                      section_definitions^ [section_ordinal]^.new := NIL;
                      section_definitions^ [section_ordinal]^.new_section_offset := 0;
                      section_definitions^ [section_ordinal]^.unallocated_common_block := FALSE;
                      section_definitions^ [section_ordinal]^.allotted_section := FALSE;
                      section_definitions^ [section_ordinal]^.allotted_section_length := 0;
                      section_definitions^ [section_ordinal]^.text := NIL;
                      section_definitions^ [section_ordinal]^.text_insertion_records.link := NIL;
                      section_definitions^ [section_ordinal]^.text_insertion_records.starting_bit_offset :=
                            -1;
                      section_definitions^ [section_ordinal]^.text_insertion_records.ending_bit_offset := -1;
                      section_definitions^ [section_ordinal]^.last_text_insertion_record :=
                            ^section_definitions^ [section_ordinal]^.text_insertion_records;
                      section_definitions^ [section_ordinal]^.last_text_insertion_point :=
                            ^section_definitions^ [section_ordinal]^.text_insertion_records;
                      section_definitions^ [section_ordinal]^.predefined_segment := TRUE;
                      section_definitions^ [section_ordinal]^.predefined_segment_number :=
                            obs_segment_definition^.segment_number;
                      section_definitions^ [section_ordinal]^.predefined_r1 := obs_segment_definition^.r1;
                      section_definitions^ [section_ordinal]^.predefined_r2 := obs_segment_definition^.r2;
                      section_definitions^ [section_ordinal]^.predefined_binding_offset := 0;
                      section_definitions^ [section_ordinal]^.predefined_binding_ordinal := 0;
                      section_definition_length := obs_segment_definition^.section_definition.length;

                      allocate_space_for_section (module_name, separated_module,
                            section_definitions^ [section_ordinal]^, status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;

                      IF (obs_segment_definition^.section_definition.kind = llc$binding_section) OR
                            (obs_segment_definition^.section_definition.kind = llc$lts_reserved) THEN
                        section_definitions^ [section_ordinal]^.section_definition.name := osc$null_name;
                      IFEND;

                    = llc$text =
                      NEXT text: [1 .. object_text_descriptor^.number_of_bytes] IN object_records;
                      IF text = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;


                      section_ordinal := text^.section_ordinal;
                      section_offset := text^.offset + object_text_descriptor^.number_of_bytes;

                      check_section_ordinal_offset (section_ordinal, section_offset, section_definitions,
                            module_name, status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;


                      add_text_record (section_definitions^ [section_ordinal]^, text, status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;

                    = llc$replication =
                      NEXT replication: [1 .. object_text_descriptor^.number_of_bytes] IN object_records;
                      IF replication = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;


                      section_ordinal := replication^.section_ordinal;
                      section_offset := replication^.offset + ((replication^.count - 1) *
                            replication^.increment) + object_text_descriptor^.number_of_bytes;

                      check_section_ordinal_offset (section_ordinal, section_offset, section_definitions,
                            module_name, status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;


                      add_replication_record (section_definitions^ [section_ordinal]^, replication, status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;

                    = llc$bit_string_insertion =
                      NEXT bit_string_insertion IN object_records;
                      IF bit_string_insertion = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;


                      section_ordinal := bit_string_insertion^.section_ordinal;
                      section_offset := bit_string_insertion^.offset +
                            ((bit_string_insertion^.bit_offset + bit_string_insertion^.bit_length + 7) DIV 8);

                      check_section_ordinal_offset (section_ordinal, section_offset, section_definitions,
                            module_name, status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;


                      add_bit_string_insertion_record (section_definitions^ [section_ordinal]^,
                            bit_string_insertion, status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;

                    = llc$entry_definition =
                      NEXT entry_definition IN object_records;


                      section_ordinal := entry_definition^.section_ordinal;
                      section_offset := entry_definition^.offset;

                      check_section_ordinal_offset (section_ordinal, section_offset, section_definitions,
                            module_name, status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;


                      NEXT last_entry_definition^.link IN segment_4;
                      last_entry_definition := last_entry_definition^.link;
                      IF last_entry_definition = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                        RETURN;
                      IFEND;

                      last_entry_definition^.entry_definition := entry_definition^;
                      last_entry_definition^.link := NIL;
                      last_entry_definition^.changed_name := ^entry_definition^.name;
                      last_entry_definition^.formal_parameter := NIL;

                      IF next_changed_entry_point <> NIL THEN
                        last_entry_definition^.changed_name := ^next_changed_entry_point^.name;
                        last_entry_definition^.entry_definition.attributes :=
                              next_changed_entry_point^.attributes;
                        next_changed_entry_point := next_changed_entry_point^.link;
                      IFEND;

                    = llc$deferred_entry_points =
                      NEXT deferred_entry_points: [1 .. object_text_descriptor^.number_of_entry_points] IN
                            object_records;
                      IF deferred_entry_points = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                      NEXT separated_module.deferred_entry_points:
                            [1 .. object_text_descriptor^.number_of_entry_points] IN segment_4;
                      IF separated_module.deferred_entry_points = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                        RETURN;
                      IFEND;

                      separated_module.deferred_entry_points^ := deferred_entry_points^;


                    = llc$deferred_common_blocks =
                      NEXT separated_module.deferred_common_blocks:
                            [1 .. object_text_descriptor^.number_of_common_blocks] IN object_records;
                      IF separated_module.deferred_common_blocks = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                    = llc$address_formulation =
                      NEXT address_formulation: [1 .. object_text_descriptor^.number_of_adr_items] IN
                            object_records;
                      IF address_formulation = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;


                      value_section := address_formulation^.value_section;

                      check_section_ordinal_offset (value_section, 0, section_definitions, module_name,
                            status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;


                      dest_section := address_formulation^.dest_section;

                      FOR i := 1 TO object_text_descriptor^.number_of_adr_items DO
                        section_offset := address_formulation^.item [i].dest_offset;

                        check_section_ordinal_offset (dest_section, section_offset, section_definitions,
                              module_name, status);
                        IF NOT status.normal THEN
                          RETURN;
                        IFEND;
                      FOREND;


                      section_definitions^ [dest_section]^.allotted_section := FALSE;


                      NEXT last_address_formulation^: [1 .. object_text_descriptor^.number_of_adr_items] IN
                            segment_3;
                      IF last_address_formulation^ = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                        RETURN;
                      IFEND;

                      last_address_formulation^^.address_formulation := address_formulation^;
                      last_address_formulation^^.link := NIL;
                      last_address_formulation := ^last_address_formulation^^.link;

                    = llc$external_linkage =
                      NEXT external_linkage: [1 .. object_text_descriptor^.number_of_ext_items] IN
                            object_records;
                      IF external_linkage = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;


                      FOR i := 1 TO object_text_descriptor^.number_of_ext_items DO
                        section_ordinal := external_linkage^.item [i].section_ordinal;
                        section_offset := external_linkage^.item [i].offset;

                        check_section_ordinal_offset (section_ordinal, section_offset, section_definitions,
                              module_name, status);
                        IF NOT status.normal THEN
                          RETURN;
                        IFEND;

                        section_definitions^ [section_ordinal]^.allotted_section := FALSE;
                      FOREND;


                      NEXT last_external_linkage^: [1 .. object_text_descriptor^.number_of_ext_items] IN
                            segment_3;
                      IF last_external_linkage^ = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                        RETURN;
                      IFEND;

                      last_external_linkage^^.external_linkage := external_linkage^;
                      last_external_linkage^^.link := NIL;
                      last_external_linkage^^.actual_parameter_list.nnext := NIL;
                      last_external_linkage := ^last_external_linkage^^.link;

                    = llc$relocation =
                      NEXT relocation: [1 .. object_text_descriptor^.number_of_rel_items] IN object_records;
                      IF relocation = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                      FOR i := 1 TO object_text_descriptor^.number_of_rel_items DO
                        section_ordinal := relocation^ [i].section_ordinal;
                        section_offset := relocation^ [i].offset;

                        check_section_ordinal_offset (section_ordinal, section_offset, section_definitions,
                              module_name, status);
                        IF NOT status.normal THEN
                          RETURN;
                        IFEND;

                        relocating_section := relocation^ [i].relocating_section;

                        check_section_ordinal_offset (relocating_section, 0, section_definitions, module_name,
                              status);
                        IF NOT status.normal THEN
                          RETURN;
                        IFEND;

                        CASE relocation^ [i].address OF
                        = llc$byte_positive, llc$byte_signed =
                          NEXT last_byte_relocation^.link IN ocv$olg_scratch_seq;
                          last_byte_relocation := last_byte_relocation^.link;
                          IF last_byte_relocation = NIL THEN
                            osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                            RETURN;
                          IFEND;

                          last_byte_relocation^.item := ^relocation^ [i];
                          last_byte_relocation^.link := NIL;

                        = llc$two_byte_positive, llc$two_byte_signed =
                          NEXT last_two_byte_relocation^.link IN ocv$olg_scratch_seq;
                          last_two_byte_relocation := last_two_byte_relocation^.link;
                          IF last_two_byte_relocation = NIL THEN
                            osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                            RETURN;
                          IFEND;

                          last_two_byte_relocation^.item := ^relocation^ [i];
                          last_two_byte_relocation^.link := NIL;

                        = llc$four_byte_positive, llc$four_byte_signed =
                          NEXT last_four_byte_relocation^.link IN ocv$olg_scratch_seq;
                          last_four_byte_relocation := last_four_byte_relocation^.link;
                          IF last_four_byte_relocation = NIL THEN
                            osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                            RETURN;
                          IFEND;

                          last_four_byte_relocation^.item := ^relocation^ [i];
                          last_four_byte_relocation^.link := NIL;

                        = llc$eight_byte_positive, llc$eight_byte_signed =
                          NEXT last_eight_byte_relocation^.link IN ocv$olg_scratch_seq;
                          last_eight_byte_relocation := last_eight_byte_relocation^.link;
                          IF last_eight_byte_relocation = NIL THEN
                            osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                            RETURN;
                          IFEND;

                          last_eight_byte_relocation^.item := ^relocation^ [i];
                          last_eight_byte_relocation^.link := NIL;

                        ELSE
                          osp$set_status_abnormal (oc, oce$e_invalid_container_adr_typ,
                                separated_module.header^.name, status);
                          RETURN;
                        CASEND;
                      FOREND;

                    = llc$binding_template =
                      NEXT binding_template IN object_records;
                      IF binding_template = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                      IF binding_template^.kind = llc$current_module THEN
                        section_ordinal := binding_template^.section_ordinal;
                        section_offset := binding_template^.offset;

                        check_section_ordinal_offset (section_ordinal, 0, section_definitions, module_name,
                              status);
                        IF NOT status.normal THEN
                          RETURN;
                        IFEND;
                      IFEND;

                      separated_module.number_of_template_items :=
                            separated_module.number_of_template_items + 1;
                      binding_template_index := binding_template^.binding_offset DIV 8;
                      WHILE binding_template_index > binding_template_list_size DO
                        NEXT old_binding_template_list: [0 .. binding_template_list_size +
                              binding_template_items] IN ocv$olg_scratch_seq;
                        IF old_binding_template_list = NIL THEN
                          osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                          RETURN;
                        IFEND;

                        FOR i := 0 TO binding_template_list_size DO
                          old_binding_template_list^ [i] := separated_module.binding_template_list^ [i];
                        FOREND;
                        FOR i := binding_template_list_size + 1 TO binding_template_list_size +
                              binding_template_items DO
                          old_binding_template_list^ [i].binding_template := NIL;
                        FOREND;

                        separated_module.binding_template_list := old_binding_template_list;
                        binding_template_list_size := binding_template_list_size + binding_template_items;
                      WHILEND;

                      old_binding_template_list^ [binding_template_index].binding_template :=
                            binding_template;
                      old_binding_template_list^ [binding_template_index].referenced_in_new_binding_sect :=
                            FALSE;

                    = llc$obsolete_formal_parameters =
                      NEXT obsolete_formal_parameters: [[REP object_text_descriptor^.sequence_length OF
                            cell]] IN object_records;
                      IF obsolete_formal_parameters = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                    = llc$formal_parameters =
                      NEXT formal_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                            object_records;
                      IF formal_parameters = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                      IF NOT (occ$parameter_checking IN debug_tables_to_omit) THEN
                        entry_def := separated_module.entry_definition_list.link;
                        WHILE (entry_def <> NIL) AND (entry_def^.entry_definition.name <>
                              formal_parameters^.procedure_name) DO
                          entry_def := entry_def^.link;
                        WHILEND;

                        IF entry_def = NIL THEN
                          osp$set_status_abnormal (oc, oce$entry_not_found_for_formal, formal_parameters^.
                                procedure_name, status);
                          osp$append_status_parameter (osc$status_parameter_delimiter, module_name, status);
                          RETURN;
                        ELSE
                          NEXT entry_def^.formal_parameter: [[REP object_text_descriptor^.sequence_length OF
                                cell]] IN segment_4;
                          IF entry_def^.formal_parameter = NIL THEN
                            osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                            RETURN;
                          IFEND;

                          entry_def^.formal_parameter^ := formal_parameters^;
                          IF entry_def^.changed_name <> NIL THEN
                            entry_def^.formal_parameter^.procedure_name := entry_def^.changed_name^;
                          IFEND;
                        IFEND;
                      IFEND;

                    = llc$actual_parameters =
                      NEXT actual_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                            object_records;
                      IF actual_parameters = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                      IF NOT (occ$parameter_checking IN debug_tables_to_omit) THEN
                        external_def := separated_module.external_linkage_list;
                        WHILE (external_def <> NIL) AND (external_def^.external_linkage.name <>
                              actual_parameters^.callee_name) DO
                          external_def := external_def^.link;
                        WHILEND;
                        IF external_def = NIL THEN
                          osp$set_status_abnormal (oc, oce$ext_not_found_for_actual,
                                actual_parameters^.callee_name, status);
                          osp$append_status_parameter (osc$status_parameter_delimiter, module_name, status);
                          RETURN;
                        ELSE
                          NEXT apl IN segment_4;
                          IF apl = NIL THEN
                            osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                            RETURN;
                          ELSE
                            NEXT apl^.actual_parameter: [[REP object_text_descriptor^.sequence_length OF
                                  cell]] IN segment_4;
                            apl^.nnext := external_def^.actual_parameter_list.nnext;
                            external_def^.actual_parameter_list.nnext := apl;
                            apl^.actual_parameter^ := actual_parameters^;
                          IFEND;
                        IFEND;
                      IFEND;

                    = llc$cybil_symbol_table_fragment =
                      NEXT debug_table_fragment: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                            object_records;
                      IF debug_table_fragment = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                      IF (identification^.object_text_version > 'V1.2') AND
                            (NOT (occ$symbol_table IN debug_tables_to_omit)) THEN
                        NEXT last_miscellaneous_record^.link IN ocv$olg_scratch_seq;
                        last_miscellaneous_record := last_miscellaneous_record^.link;
                        IF last_miscellaneous_record = NIL THEN
                          osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                          RETURN;
                        IFEND;

                        NEXT last_miscellaneous_record^.debug_table_fragment:
                              [[REP object_text_descriptor^.sequence_length OF cell]] IN ocv$olg_scratch_seq;
                        IF last_miscellaneous_record^.debug_table_fragment = NIL THEN
                          osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                          RETURN;
                        IFEND;

                        last_miscellaneous_record^.kind := llc$cybil_symbol_table_fragment;
                        last_miscellaneous_record^.debug_table_fragment^ := debug_table_fragment^;
                        last_miscellaneous_record^.link := NIL;
                      IFEND;

                    = llc$obsolete_line_table =
                      NEXT obsolete_line_address_table: [1 .. object_text_descriptor^.number_of_line_items] IN
                            object_records;
                      IF obsolete_line_address_table = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                      IF NOT (occ$line_table IN debug_tables_to_omit) THEN
                        NEXT last_miscellaneous_record^.link IN ocv$olg_scratch_seq;
                        last_miscellaneous_record := last_miscellaneous_record^.link;
                        IF last_miscellaneous_record = NIL THEN
                          osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                          RETURN;
                        IFEND;

                        NEXT last_miscellaneous_record^.obsolete_line_address_table:
                              [1 .. object_text_descriptor^.number_of_line_items] IN ocv$olg_scratch_seq;
                        IF last_miscellaneous_record^.obsolete_line_address_table = NIL THEN
                          osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                          RETURN;
                        IFEND;

                        last_miscellaneous_record^.kind := llc$obsolete_line_table;
                        last_miscellaneous_record^.obsolete_line_address_table^ :=
                              obsolete_line_address_table^;
                        last_miscellaneous_record^.link := NIL;
                      IFEND;

                    = llc$symbol_table =
                      NEXT symbol_table: [[REP object_text_descriptor^.sequence_length OF cell]] IN
                            object_records;
                      IF symbol_table = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                      IF NOT (occ$symbol_table IN debug_tables_to_omit) THEN
                        NEXT last_miscellaneous_record^.link IN ocv$olg_scratch_seq;
                        last_miscellaneous_record := last_miscellaneous_record^.link;
                        IF last_miscellaneous_record = NIL THEN
                          osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                          RETURN;
                        IFEND;

                        NEXT last_miscellaneous_record^.symbol_table:
                              [[REP object_text_descriptor^.sequence_length OF cell]] IN ocv$olg_scratch_seq;
                        IF last_miscellaneous_record^.symbol_table = NIL THEN
                          osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                          RETURN;
                        IFEND;

                        last_miscellaneous_record^.kind := llc$symbol_table;
                        last_miscellaneous_record^.symbol_table^ := symbol_table^;
                        last_miscellaneous_record^.link := NIL;
                      IFEND;

                    = llc$line_table =
                      NEXT line_address_table: [1 .. object_text_descriptor^.number_of_line_items] IN
                            object_records;
                      IF line_address_table = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                      IF NOT (occ$line_table IN debug_tables_to_omit) THEN
                        NEXT last_miscellaneous_record^.link IN ocv$olg_scratch_seq;
                        last_miscellaneous_record := last_miscellaneous_record^.link;
                        IF last_miscellaneous_record = NIL THEN
                          osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                          RETURN;
                        IFEND;

                        NEXT last_miscellaneous_record^.line_address_table:
                              [1 .. object_text_descriptor^.number_of_line_items] IN ocv$olg_scratch_seq;
                        IF last_miscellaneous_record^.line_address_table = NIL THEN
                          osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                          RETURN;
                        IFEND;

                        last_miscellaneous_record^.kind := llc$line_table;
                        last_miscellaneous_record^.line_address_table^ := line_address_table^;
                        last_miscellaneous_record^.link := NIL;
                      IFEND;

                    = llc$supplemental_debug_tables =
                      NEXT supplemental_debug_tables: [[REP object_text_descriptor^.sequence_length OF
                            cell]] IN object_records;
                      IF supplemental_debug_tables = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                      IF NOT (occ$supplemental_debug_table IN debug_tables_to_omit) THEN
                        NEXT last_miscellaneous_record^.link IN ocv$olg_scratch_seq;
                        last_miscellaneous_record := last_miscellaneous_record^.link;
                        IF last_miscellaneous_record = NIL THEN
                          osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                          RETURN;
                        IFEND;

                        NEXT last_miscellaneous_record^.supplemental_debug_tables:
                              [[REP object_text_descriptor^.sequence_length OF cell]] IN ocv$olg_scratch_seq;
                        IF last_miscellaneous_record^.supplemental_debug_tables = NIL THEN
                          osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                          RETURN;
                        IFEND;

                        last_miscellaneous_record^.kind := llc$supplemental_debug_tables;
                        last_miscellaneous_record^.supplemental_debug_tables^ := supplemental_debug_tables^;
                        last_miscellaneous_record^.link := NIL;
                      IFEND;


                    = llc$form_definition =
                      osp$set_status_abnormal (oc, oce$e_form_def_found_in_module, module_name, status);
                      RETURN;


                    = llc$68000_absolute =
                      NEXT m68000_absolute: [[REP object_text_descriptor^.number_of_68000_bytes OF cell]] IN
                            object_records;
                      IF m68000_absolute = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                      NEXT last_miscellaneous_record^.link IN ocv$olg_scratch_seq;
                      last_miscellaneous_record := last_miscellaneous_record^.link;
                      IF last_miscellaneous_record = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                        RETURN;
                      IFEND;

                      last_miscellaneous_record^.kind := llc$68000_absolute;
                      last_miscellaneous_record^.m68000_absolute := m68000_absolute;
                      last_miscellaneous_record^.link := NIL;


                    = llc$transfer_symbol =
                      NEXT transfer_symbol IN object_records;
                      IF transfer_symbol = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                        RETURN;
                      IFEND;

                      separated_module.starting_procedure := transfer_symbol^.name;


                      IF (any_obsolete_segment_defs) THEN
                        binding_section_ordinal := 0;
                        found := FALSE;

                        i := 0;
                        WHILE (i <= greatest_section_ordinal) AND (NOT found) DO
                          IF (section_definitions^ [i] <> NIL) AND (section_definitions^ [i]^.
                                section_definition.kind = llc$binding_section) THEN
                            binding_section_ordinal := section_definitions^ [section_ordinal]^.
                                  section_definition.section_ordinal;
                            found := TRUE;
                          IFEND;
                          i := i + 1;
                        WHILEND;

                        FOR i := 0 TO greatest_section_ordinal DO
                          IF (section_definitions^ [i] <> NIL) AND (section_definitions^ [i]^.
                                section_definition.kind = llc$code_section) THEN
                            section_definitions^ [i]^.predefined_binding_ordinal := binding_section_ordinal;
                          IFEND;
                        FOREND;
                      IFEND;


                    ELSE
                      osp$set_status_abnormal (oc, oce$e_invalid_object_rec_kind, module_name, status);
                      osp$append_status_integer (osc$status_parameter_delimiter, record_number, 10, FALSE,
                            status);
                      RETURN;
                    CASEND;

                  UNTIL object_text_descriptor^.kind = llc$transfer_symbol;

                  segment_length := i#current_sequence_position (segment_1);
                  mmp$advise_out (segment_1, segment_length, status);
                  IF NOT status.normal THEN
                    RETURN;
                  IFEND;

                  segment_length := i#current_sequence_position (segment_2);
                  mmp$advise_out (segment_2, segment_length, status);
                  IF NOT status.normal THEN
                    RETURN;
                  IFEND;

                  segment_length := i#current_sequence_position (segment_3);
                  mmp$advise_out (segment_3, segment_length, status);
                  IF NOT status.normal THEN
                    RETURN;
                  IFEND;

                  segment_length := i#current_sequence_position (segment_4);
                  mmp$advise_out (segment_4, segment_length, status);
                  IF NOT status.normal THEN
                    RETURN;
                  IFEND;

                PROCEND separate_object_records;
?? OLDTITLE ??
?? NEWTITLE := '                COLLECT_FROM_INFO_HEADER' ??
?? EJECT ??

                PROCEDURE collect_from_info_header
                  (    module_name: pmt$program_name;
                       info_element_header: ^llt$info_element_header;
                   VAR file: ^SEQ ( * );
                   VAR separated_module: oct$separated_module_header;
                   VAR status: ost$status);


                  VAR
                    relocation: ^llt$relocation,
                    binding_section_template: ^llt$binding_section_template,
                    components: ^llt$component_information,
                    index: llt$number_of_info_elements,
                    i: integer,
                    last_byte_relocation: ^oct$relocation_item_list,
                    last_two_byte_relocation: ^oct$relocation_item_list,
                    last_four_byte_relocation: ^oct$relocation_item_list,
                    last_eight_byte_relocation: ^oct$relocation_item_list;


                  IF info_element_header^.number_of_rel_items <> 0 THEN
                    separated_module.relocation_list.byte.link := NIL;
                    last_byte_relocation := ^separated_module.relocation_list.byte;
                    separated_module.relocation_list.two_byte.link := NIL;
                    last_two_byte_relocation := ^separated_module.relocation_list.two_byte;
                    separated_module.relocation_list.four_byte.link := NIL;
                    last_four_byte_relocation := ^separated_module.relocation_list.four_byte;
                    separated_module.relocation_list.eight_byte.link := NIL;
                    last_eight_byte_relocation := ^separated_module.relocation_list.eight_byte;

                    relocation := #PTR (info_element_header^.relocation_ptr, file^);
                    IF relocation = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                      RETURN;
                    IFEND;

                    FOR i := 1 TO info_element_header^.number_of_rel_items DO
                      CASE relocation^ [i].address OF
                      = llc$byte_positive, llc$byte_signed =
                        NEXT last_byte_relocation^.link IN ocv$olg_scratch_seq;
                        last_byte_relocation := last_byte_relocation^.link;
                        IF last_byte_relocation = NIL THEN
                          osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                          RETURN;
                        IFEND;

                        last_byte_relocation^.item := ^relocation^ [i];
                        last_byte_relocation^.link := NIL;

                      = llc$two_byte_positive, llc$two_byte_signed =
                        NEXT last_two_byte_relocation^.link IN ocv$olg_scratch_seq;
                        last_two_byte_relocation := last_two_byte_relocation^.link;
                        IF last_two_byte_relocation = NIL THEN
                          osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                          RETURN;
                        IFEND;

                        last_two_byte_relocation^.item := ^relocation^ [i];
                        last_two_byte_relocation^.link := NIL;

                      = llc$four_byte_positive, llc$four_byte_signed =
                        NEXT last_four_byte_relocation^.link IN ocv$olg_scratch_seq;
                        last_four_byte_relocation := last_four_byte_relocation^.link;
                        IF last_four_byte_relocation = NIL THEN
                          osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                          RETURN;
                        IFEND;

                        last_four_byte_relocation^.item := ^relocation^ [i];
                        last_four_byte_relocation^.link := NIL;

                      = llc$eight_byte_positive, llc$eight_byte_signed =
                        NEXT last_eight_byte_relocation^.link IN ocv$olg_scratch_seq;
                        last_eight_byte_relocation := last_eight_byte_relocation^.link;
                        IF last_eight_byte_relocation = NIL THEN
                          osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                          RETURN;
                        IFEND;

                        last_eight_byte_relocation^.item := ^relocation^ [i];
                        last_eight_byte_relocation^.link := NIL;

                      ELSE
                        osp$set_status_abnormal (oc, oce$e_invalid_container_adr_typ,
                              separated_module.header^.name, status);
                        RETURN;
                      CASEND;
                    FOREND;

                  IFEND;

                  IF info_element_header^.number_of_template_items <> 0 THEN
                    binding_section_template := #PTR (info_element_header^.binding_template_ptr, file^);
                    IF binding_section_template = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                      RETURN;
                    IFEND;

{ The BINDING_TEMPLATE_LIST being set up here is an array where each entry represents a word in the
{ binding section (ie. entry 0 represents the first 8 bytes in the binding section, entry 1 represents
{ the second 8 bytes in the binding section, etc.).  This allows the binding template item for any
{ binding offset to be found directly by dividing the binding offset by 8 to get the index into this
{ array which contains a pointer to the binding template item.  Note that each entry in the binding
{ section is either 1 word or 2 words long and the binding offset will either be on a word boundary or
{ in the case of an internal address, the word boundary + 2.
{
{ The size of the array was chosen to be the number_of_template_items * 2 because the maximum size of an
{ entry in the binding section is 2 words.  This should be more than adequate since many entries should
{ only be 1 word in length.

                    NEXT separated_module.binding_template_list: [0 .. (info_element_header^.
                          number_of_template_items * 2)] IN ocv$olg_scratch_seq;
                    IF separated_module.binding_template_list = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                      RETURN;
                    IFEND;

                    separated_module.number_of_template_items := info_element_header^.
                          number_of_template_items;

                    FOR i := 0 TO (info_element_header^.number_of_template_items * 2) DO
                      separated_module.binding_template_list^ [i].binding_template := NIL;
                    FOREND;

                    FOR i := 1 TO info_element_header^.number_of_template_items DO
                      index := binding_section_template^ [i].binding_offset DIV 8;
                      separated_module.binding_template_list^ [index].binding_template :=
                            ^binding_section_template^ [i];
                      separated_module.binding_template_list^ [index].referenced_in_new_binding_sect := FALSE;
                    FOREND;
                  IFEND;

                  IF info_element_header^.number_of_section_maps <> 0 THEN
                    components := #PTR (info_element_header^.component_ptr, file^);
                    IF components = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                      RETURN;
                    IFEND;

                    NEXT separated_module.components: [1 .. info_element_header^.number_of_components] IN
                          ocv$olg_scratch_seq;
                    IF separated_module.components = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                      RETURN;
                    IFEND;

                    FOR i := 1 TO info_element_header^.number_of_components DO
                      separated_module.components^ [i].description := components^ [i];
                    FOREND;


                    separated_module.section_maps := #PTR (info_element_header^.section_maps, file^);
                    IF separated_module.section_maps = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_name, status);
                      RETURN;
                    IFEND;
                  IFEND;


                PROCEND collect_from_info_header;
?? OLDTITLE ??
?? EJECT ??


                VAR
                  i: llt$module_index,
                  object_text_descriptor: ^llt$object_text_descriptor,
                  new_header: llt$info_element_header,
                  info_element_header: ^llt$info_element_header;


                FOR i := 1 TO UPPERBOUND (bound_components^) DO

                  CASE bound_components^ [i]^.kind OF
                  = occ$load_module =
                    object_text_descriptor := #PTR (bound_components^ [i]^.load_module_header^.
                          interpretive_element, bound_components^ [i]^.file^);
                    IF object_text_descriptor = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_premature_eof_on_file, bound_components^ [i]^.name,
                            status);
                      RETURN;
                    IFEND;

                    RESET bound_components^ [i]^.file TO object_text_descriptor;
                    NEXT object_text_descriptor IN bound_components^ [i]^.file;

                    separate_object_records (bound_components^ [i]^.name, debug_tables_to_omit,
                          bound_components^ [i]^.file, changed_entry_points, separated_components^ [i],
                          status);
                    IF NOT status.normal THEN
                      RETURN;
                    IFEND;

                    IF llc$information_element IN bound_components^ [i]^.load_module_header^.
                          elements_defined THEN
                      info_element_header := #PTR (bound_components^ [i]^.load_module_header^.
                            information_element, bound_components^ [i]^.file^);

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

                      collect_from_info_header (bound_components^ [i]^.name, info_element_header,
                            bound_components^ [i]^.file, separated_components^ [i], status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;
                    IFEND;

                  = occ$cpu_object_module =
                    RESET bound_components^ [i]^.file TO bound_components^ [i]^.cpu_object_module_header^.
                          identification;
                    separate_object_records (bound_components^ [i]^.name, debug_tables_to_omit,
                          bound_components^ [i]^.file, changed_entry_points, separated_components^ [i],
                          status);
                    IF NOT status.normal THEN
                      RETURN;
                    IFEND;


                  CASEND;
                FOREND;


              PROCEND separate_components;
?? OLDTITLE ??
?? NEWTITLE := '              COLLECT_COMPONENT_INFO' ??
?? EJECT ??

              PROCEDURE collect_component_info
                (    component: ^oct$separated_components;
                 VAR component_info: ^llt$component_information;
                 VAR status: ost$status);


                VAR
                  i: integer,
                  j: integer,
                  count: integer,
                  component_description: ^llt$component_description,
                  reset_value: ^SEQ ( * );


                count := 0;
                reset_value := ocv$olg_scratch_seq;

                FOR i := 1 TO UPPERBOUND (component^) DO
                  IF component^ [i].components = NIL THEN
                    NEXT component_description IN ocv$olg_scratch_seq;
                    IF component_description = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                      RETURN;
                    IFEND;

                    count := count + 1;
                    component^ [i].component_number := count;
                    component_description^.name := component^ [i].header^.name;
                    component_description^.time_created := component^ [i].header^.time_created;
                    component_description^.date_created := component^ [i].header^.date_created;
                    component_description^.generator_id := component^ [i].header^.generator_id;
                    component_description^.generator_name_vers := component^ [i].header^.generator_name_vers;
                    component_description^.commentary := component^ [i].header^.commentary;
                  ELSE
                    FOR j := 1 TO UPPERBOUND (component^ [i].components^) DO
                      NEXT component_description IN ocv$olg_scratch_seq;
                      IF component_description = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                        RETURN;
                      IFEND;

                      count := count + 1;
                      component^ [i].components^ [j].new_component_number := count;
                      component_description^ := component^ [i].components^ [j].description;
                    FOREND;
                  IFEND;
                FOREND;

                ocv$olg_scratch_seq := reset_value;
                NEXT component_info: [1 .. count] IN ocv$olg_scratch_seq;


              PROCEND collect_component_info;
?? OLDTITLE ??
?? NEWTITLE := '              COLLECT_LIBRARIES' ??
?? EJECT ??

              PROCEDURE collect_libraries
                (    component: oct$separated_module_header;
                 VAR new_modules_library_list: oct$name_list;
                 VAR status: ost$status);

                VAR
                  library: 1 .. llc$max_libraries,
                  new_library: ^oct$name_list,
                  component_library: ^oct$library_list;


                component_library := component.library_list.link;

                WHILE component_library <> NIL DO
                  FOR library := LOWERBOUND (component_library^.libraries^)
                        TO UPPERBOUND (component_library^.libraries^) DO

                    new_library := ^new_modules_library_list;

                    WHILE (new_library^.link <> NIL) AND (new_library^.link^.name <>
                          component_library^.libraries^ [library]) DO
                      new_library := new_library^.link;
                    WHILEND;

                    IF new_library^.link = NIL THEN
                      NEXT new_library^.link IN ocv$olg_scratch_seq;
                      new_library := new_library^.link;
                      IF new_library = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                        RETURN;
                      IFEND;

                      new_library^.name := component_library^.libraries^ [library];
                      new_library^.link := NIL;
                    IFEND;
                  FOREND;

                  component_library := component_library^.link;
                WHILEND;


              PROCEND collect_libraries;
?? OLDTITLE ??
?? NEWTITLE := '              COLLECT_SECTION_RECORDS' ??
?? EJECT ??

              PROCEDURE collect_section_records
                (VAR component: oct$separated_module_header;
                 VAR current_section_ordinal: 0 .. llc$max_section_ordinal + 1;
                 VAR section_definitions: oct$section_definition_list;
                 VAR status: ost$status);

?? NEWTITLE := '                GET_NEW_SECTION' ??
?? NEWTITLE := '                  CONVERT_RW_TO_ALLOTTED_SEGMENT', EJECT ??

                PROCEDURE get_new_section
                  (VAR old_section: oct$section_definition;
                   VAR section_definitions: oct$section_definition_list;
                   VAR current_section_ordinal: 0 .. llc$max_section_ordinal + 1;
                   VAR new_section: ^oct$section_definition_list;
                   VAR status: ost$status);






                  PROCEDURE convert_rw_to_allotted_segment
                    (VAR old: oct$section_definition);


                    VAR
                      tir: ^oct$text_insertion_list;



                    IF NOT (llc$binding IN old.section_definition.access_attributes) THEN
                      tir := old.text_insertion_records.link;
                      IF (tir <> NIL) AND (tir^.kind = llc$text) AND (tir^.link = NIL) THEN
                        IF (#SIZE (tir^.text^.byte) >= occ$min_shadow_size) THEN
                          IF ((occ$min_shadow_size MOD old.section_definition.allocation_alignment) = 0) THEN
                            old.allotted_section := TRUE;
                            old.allotted_section_length := (((#SIZE (tir^.text^.byte) + occ$min_shadow_size -
                                  1) DIV occ$min_shadow_size) * occ$min_shadow_size);
                            old.section_definition.allocation_offset := 0;
                            old.section_definition.allocation_alignment := occ$min_shadow_size;
                          IFEND;
                        IFEND;
                      IFEND;
                    IFEND;


                  PROCEND convert_rw_to_allotted_segment;
?? OLDTITLE ??
?? EJECT ??


                  new_section := ^section_definitions;

                  WHILE new_section^.link <> NIL DO
                    new_section := new_section^.link;

                    IF NOT (old_section.predefined_segment OR new_section^.predefined_segment) THEN
                      IF (NOT quick_bind) OR (old_section.section_definition.kind <> llc$code_section) THEN
                        IF old_section.section_definition.kind <> llc$lts_reserved THEN
                          IF (old_section.section_definition.name = new_section^.section_definition.name) OR
                                (new_section^.section_definition.kind = llc$code_section) THEN
                            IF ((old_section.section_definition.kind = llc$common_block) OR
                                  (old_section.section_definition.kind = llc$extensible_common_block)) AND
                                  ((new_section^.section_definition.kind = llc$common_block) OR
                                  (new_section^.section_definition.kind = llc$extensible_common_block)) THEN
                              new_section^.section_definition.access_attributes :=
                                    new_section^.section_definition.access_attributes +
                                    old_section.section_definition.access_attributes;
                              new_section^.allotted_section := new_section^.allotted_section AND
                                    old_section.allotted_section;
                              RETURN;
                            IFEND;

                            IF old_section.section_definition.kind = new_section^.section_definition.kind THEN
                              IF old_section.section_definition.kind <> llc$extensible_working_storage THEN
                                IF (old_section.section_definition.kind = llc$binding_section) OR
                                      (old_section.section_definition.access_attributes =
                                      new_section^.section_definition.access_attributes) THEN
                                  IF old_section.allotted_section = new_section^.allotted_section THEN
                                    RETURN;
                                  IFEND;
                                IFEND;
                              IFEND;
                            IFEND;
                          IFEND;
                        IFEND;
                      IFEND;
                    IFEND;
                  WHILEND;

                  IF current_section_ordinal >= llc$max_section_ordinal THEN
                    osp$set_status_abnormal (oc, oce$e_too_many_section_defns, '', status);
                    RETURN;
                  IFEND;

                  NEXT new_section^.link IN segment_1;
                  new_section := new_section^.link;
                  IF new_section = NIL THEN
                    osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                    RETURN;
                  IFEND;

                  IF (old_section.predefined_segment) AND (NOT old_section.allotted_section) THEN
                    convert_rw_to_allotted_segment (old_section);
                  IFEND;

                  new_section^.link := NIL;
                  new_section^.section_definition := old_section.section_definition;
                  new_section^.section_definition.section_ordinal := current_section_ordinal;
                  current_section_ordinal := current_section_ordinal + 1;

                  IF old_section.section_definition.kind = llc$binding_section THEN
                    new_section^.section_definition.access_attributes :=
                          $llt$section_access_attributes [llc$read, llc$binding];
                  IFEND;

                  new_section^.predefined_segment := old_section.predefined_segment;
                  new_section^.predefined_segment_number := old_section.predefined_segment_number;
                  new_section^.predefined_r1 := old_section.predefined_r1;
                  new_section^.predefined_r2 := old_section.predefined_r2;
                  new_section^.predefined_binding_ordinal := old_section.predefined_binding_ordinal;
                  new_section^.predefined_binding_offset := old_section.predefined_binding_offset;
                  new_section^.section_ptr := NIL;
                  new_section^.old_sections.link := NIL;
                  new_section^.last_old_section := ^new_section^.old_sections;
                  new_section^.unallocated_common_block := old_section.unallocated_common_block;
                  new_section^.allotted_section := old_section.allotted_section;
                  new_section^.allotted_section_length := old_section.allotted_section_length;
                  new_section^.text_insertion_records.link := NIL;

{ Make sure that the binding section has the greatest section ordinal

                  IF ocv$binding_section <> NIL THEN
                    new_section^.section_definition.section_ordinal :=
                          ocv$binding_section^.section_definition.section_ordinal;
                    ocv$binding_section^.section_definition.section_ordinal := current_section_ordinal - 1;
                  ELSEIF new_section^.section_definition.kind = llc$binding_section THEN
                    ocv$binding_section := new_section;
                  IFEND;


                PROCEND get_new_section;
?? OLDTITLE ??
?? EJECT ??

                VAR
                  section_ordinal: llt$section_ordinal,
                  new_section: ^oct$section_definition_list;


                FOR section_ordinal := 0 TO UPPERBOUND (component.section_definitions^) DO
                  IF component.section_definitions^ [section_ordinal] <> NIL THEN
                    get_new_section (component.section_definitions^ [section_ordinal]^, section_definitions,
                          current_section_ordinal, new_section, status);
                    IF NOT status.normal THEN
                      RETURN;
                    IFEND;

                    component.section_definitions^ [section_ordinal]^.new := new_section;

                    NEXT new_section^.last_old_section^.link IN segment_1;
                    new_section^.last_old_section := new_section^.last_old_section^.link;
                    IF new_section^.last_old_section = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                      RETURN;
                    IFEND;

                    new_section^.last_old_section^.component := ^component;
                    new_section^.last_old_section^.section_ordinal := section_ordinal;
                    new_section^.last_old_section^.link := NIL;
                  IFEND;
                FOREND;


              PROCEND collect_section_records;
?? OLDTITLE ??
?? NEWTITLE := '              SORT_CODE_SECTIONS', EJECT ??

              PROCEDURE sort_code_sections
                (    code_section_ids: oct$code_section_ids;
                     section_definitions: oct$section_definition_list);


                VAR
                  code: ^oct$section_definition_list,
                  last: ^oct$old_section_list,
                  old: ^oct$old_section_list,
                  temp: ^oct$old_section_list,
                  id: ^oct$code_section_ids;


                IF code_section_ids.link <> NIL THEN
                  code := section_definitions.link;
                  WHILE code^.section_definition.kind <> llc$code_section DO
                    code := code^.link;
                  WHILEND;

                  id := code_section_ids.link;
                  last := ^code^.old_sections;

                  WHILE id <> NIL DO
                    old := last;

                    WHILE (id^.name <> old^.link^.component^.header^.name) OR
                          (id^.section_ordinal <> old^.link^.section_ordinal) DO
                      old := old^.link;
                    WHILEND;

                    temp := old^.link;
                    old^.link := temp^.link;

                    temp^.link := last^.link;
                    last^.link := temp;

                    last := last^.link;

                    id := id^.link;
                  WHILEND;
                IFEND;


              PROCEND sort_code_sections;
?? OLDTITLE ??
?? NEWTITLE := '              BUILD_COMPOSITE_SECTIONS', EJECT ??

              PROCEDURE build_composite_sections
                (VAR section_definitions: oct$section_definition_list;
                 VAR status: ost$status);

?? NEWTITLE := '                UPDATE_SECTION', EJECT ??

                PROCEDURE update_section
                  (VAR composite: oct$section_definition_list;
                   VAR status: ost$status);

?? NEWTITLE := '                  RELOCATE_LINE_TABLE', EJECT ??

                  PROCEDURE relocate_obsolete_line_table
                    (    component: ^oct$separated_module_header;
                         section_ordinal: llt$section_ordinal;
                     VAR status: ost$status);


                    VAR
                      sequence: ^oct$olg_scratch_seq,
                      obsolete_line_table: ^llt$obsolete_line_address_table,
                      i: integer,
                      size: integer,
                      number_of_items: integer;


                    IF component^.section_definitions^ [section_ordinal]^.text <> NIL THEN
                      size := #SIZE (component^.section_definitions^ [section_ordinal]^.text^) -
                            (#SIZE (pmt$program_name) + #SIZE (boolean) + #SIZE (llt$module_generator) +
                            #SIZE (llt$line_address_table_size));
                      number_of_items := size DIV #SIZE (llt$obsolete_line_address_item);
                      IF number_of_items > 0 THEN
                        sequence := ocv$olg_scratch_seq;
                        RESET sequence TO component^.section_definitions^ [section_ordinal]^.text;

                        NEXT obsolete_line_table: [1 .. number_of_items] IN sequence;

                        FOR i := 1 TO number_of_items DO
                          check_section_ordinal_offset (obsolete_line_table^.item [i].section_ordinal,
                                obsolete_line_table^.item [i].offset, component^.section_definitions,
                                component^.header^.name, status);
                          IF NOT status.normal THEN
                            RETURN;
                          IFEND;

                          obsolete_line_table^.item [i].offset := relocated_section_offset
                                (component^, obsolete_line_table^.item [i].section_ordinal,
                                obsolete_line_table^.item [i].offset);
                          relocated_section_ordinal (component^, obsolete_line_table^.item [i].
                                section_ordinal, obsolete_line_table^.item [i].section_ordinal);
                        FOREND;
                      IFEND;
                    ELSE
                      osp$set_status_abnormal (oc, oce$e_bad_line_table, component^.header^.name, status);
                    IFEND;


                  PROCEND relocate_obsolete_line_table;
?? OLDTITLE ??
?? EJECT ??


                  VAR
                    offset: ost$segment_length,
                    old_section: ^oct$old_section_list,
                    old: ^oct$section_definition,
                    temp: ost$segment_length;


                  composite.section_definition.allocation_offset := 0;

                  offset := 0;
                  old_section := composite.old_sections.link;

                  WHILE old_section <> NIL DO
                    old := old_section^.component^.section_definitions^ [old_section^.section_ordinal];

{ compute new allocation alignment

                    temp := 1;
                    WHILE (temp < old^.section_definition.allocation_alignment) AND
                          ((temp * composite.section_definition.allocation_alignment) MOD
                          old^.section_definition.allocation_alignment <> 0) DO
                      temp := temp + 1;
                    WHILEND;

                    composite.section_definition.allocation_alignment :=
                          temp * composite.section_definition.allocation_alignment;


                    IF old^.section_definition.length <> 0 THEN
                      WHILE (offset MOD old^.section_definition.allocation_alignment) <>
                            old^.section_definition.allocation_offset DO
                        offset := offset + 1;
                      WHILEND;
                    IFEND;

                    old^.new_section_offset := offset;
                    offset := offset + old^.section_definition.length;

                    IF old^.section_definition.kind = llc$lts_reserved THEN
                      relocate_obsolete_line_table (old_section^.component, old_section^.section_ordinal,
                            status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;
                    IFEND;

                    old_section := old_section^.link;
                  WHILEND;

                  composite.section_definition.length := offset;


                  IF (composite.section_definition.kind = llc$code_section) THEN
                    IF (NOT quick_bind) THEN
                      composite.section_definition.name := osc$null_name;
                    IFEND;

                    IF (composite.predefined_segment) AND (ocv$binding_section <> NIL) THEN
                      composite.predefined_binding_ordinal := ocv$binding_section^.section_definition.
                            section_ordinal;
                    IFEND;
                  IFEND;

                PROCEND update_section;
?? OLDTITLE ??
?? NEWTITLE := '                  UPDATE_COMMON_SECTION', EJECT ??

                PROCEDURE update_common_section
                  (VAR composite: oct$section_definition_list);


                  VAR
                    offset: ost$segment_length,
                    old_section: ^oct$old_section_list,
                    old: ^oct$section_definition,
                    temp: ost$segment_length,
                    local_status: ost$status;


                  offset := composite.section_definition.allocation_offset;

                  old_section := composite.old_sections.link;

                  WHILE old_section <> NIL DO
                    old := old_section^.component^.section_definitions^ [old_section^.section_ordinal];

                    IF old^.section_definition.kind <> composite.section_definition.kind THEN
                      osp$set_status_abnormal (oc, oce$w_conflicting_com_attribute,
                            composite.section_definition.name, local_status);
                      ocp$generate_message (local_status);
                    IFEND;

                    IF old^.section_definition.access_attributes <>
                          composite.section_definition.access_attributes THEN
                      osp$set_status_abnormal (oc, oce$w_conflicting_com_attribute,
                            composite.section_definition.name, local_status);
                      ocp$generate_message (local_status);
                    IFEND;

                    IF (old^.section_definition.allocation_alignment <>
                          composite.section_definition.allocation_alignment) OR
                          (old^.section_definition.allocation_offset <>
                          composite.section_definition.allocation_offset) THEN
                      osp$set_status_abnormal (oc, oce$w_conflicting_com_attribute,
                            composite.section_definition.name, local_status);
                      ocp$generate_message (local_status);
                    IFEND;

                    IF old^.section_definition.length > composite.section_definition.length THEN
                      IF composite.section_definition.kind = llc$extensible_common_block THEN
                        composite.section_definition.length := old^.section_definition.length;
                      ELSE
                        osp$set_status_abnormal (oc, oce$w_conflicting_common_length,
                              composite.section_definition.name, local_status);
                        ocp$generate_message (local_status);
                        old^.section_definition.length := composite.section_definition.length;
                      IFEND;
                    IFEND;

                    old^.new_section_offset := offset;

                    old_section := old_section^.link;
                  WHILEND;

                  composite.section_definition.allocation_offset := 0;
                  composite.section_definition.length := composite.section_definition.length + offset;


                PROCEND update_common_section;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] initialize_preset_segment', EJECT ??

{ PURPOSE:
{   The purpose of this request is to determine if a preset segment exists or
{   not and, if it does not exist, to create it.
{ NOTE:
{   This request must NOT be called in a loop since it has automatic variable
{   space.  If the need to call this request in a loop arises, this cannot be
{   inline any longer.

                PROCEDURE [INLINE] initialize_preset_segment
                  (    preset_value: pmt$initialization_value;
                   VAR status: ost$status);

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

                  status.normal := TRUE;
                  IF preset_segment [preset_value].sequence_pointer = NIL THEN
                    PUSH segment_attributes_p: [1 .. 1];
                    segment_attributes_p^ [1].keyword := mmc$ua_preset_value;
                    segment_attributes_p^ [1].preset_value := preset_value;
                    mmp$create_user_segment (segment_attributes_p, amc$sequence_pointer, mmc$as_random,
                          preset_segment [preset_value], status);
                    IF status.normal THEN
                      RESET preset_segment [preset_value].sequence_pointer;
                    IFEND;
                  IFEND;

                PROCEND initialize_preset_segment;
?? OLDTITLE ??
?? NEWTITLE := 'collect_allotted_sections', EJECT ??

                PROCEDURE collect_allotted_sections
                  (VAR composite: oct$section_definition_list;
                   VAR status: ost$status);


                  VAR
                    cell_ptr: ^cell,
                    current_sequence_position: ost$segment_offset,
                    old_section: ^oct$old_section_list,
                    old: ^oct$section_definition,
                    preset_value: pmt$initialization_value,
                    seq_ptr: ^SEQ ( * ),
                    valid_position: boolean;

                  preset_value := bound_module.preset_value;
                  initialize_preset_segment (preset_value, status);
                  IF NOT status.normal THEN
                    RETURN;
                  IFEND;

                  current_sequence_position := i#current_sequence_position
                        (preset_segment [preset_value].sequence_pointer);
                  WHILE (current_sequence_position MOD composite.section_definition.allocation_alignment) <>
                        composite.section_definition.allocation_offset DO
                    current_sequence_position := current_sequence_position + 1;
                  WHILEND;
                  pmp$position_object_library (preset_segment [preset_value].sequence_pointer,
                        current_sequence_position, valid_position);
                  IF NOT valid_position THEN
                    osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
                    RETURN;
                  IFEND;

                  seq_ptr := preset_segment [preset_value].sequence_pointer;

                  IF composite.section_definition.length <> 0 THEN
                    NEXT composite.section_ptr: [0 .. composite.section_definition.length - 1] IN
                          preset_segment [preset_value].sequence_pointer;
                    IF composite.section_ptr = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                      RETURN;
                    IFEND;

                    old_section := composite.old_sections.link;

                    WHILE old_section <> NIL DO
                      old := old_section^.component^.section_definitions^ [old_section^.section_ordinal];

                      IF old^.text <> NIL THEN
                        cell_ptr := #LOC (composite.section_ptr^ [old^.new_section_offset]);
                        i#move (#LOC (old^.text^ [1]), cell_ptr, old^.section_definition.length);

                        RESET seq_ptr TO cell_ptr;
                        NEXT old^.text: [1 .. old^.section_definition.length] IN seq_ptr;
                      IFEND;

                      old_section := old_section^.link;
                    WHILEND;
                  IFEND;


                PROCEND collect_allotted_sections;
?? OLDTITLE ??
?? NEWTITLE := '              COLLECT_ALLOTTED_RW_SECTIONS', EJECT ??

                PROCEDURE collect_allotted_rw_sections
                  (VAR composite: oct$section_definition_list;
                   VAR status: ost$status);


                  VAR
                    current_sequence_position: ost$segment_offset,
                    length: ost$segment_length,
                    old_section: ^oct$old_section_list,
                    old: ^oct$section_definition,
                    preset_value: pmt$initialization_value,
                    tir: ^oct$text_insertion_list,
                    valid_position: boolean;

                  preset_value := bound_module.preset_value;
                  initialize_preset_segment (preset_value, status);
                  IF NOT status.normal THEN
                    RETURN;
                  IFEND;

                  current_sequence_position := i#current_sequence_position
                        (preset_segment [preset_value].sequence_pointer);
                  WHILE (current_sequence_position MOD composite.section_definition.allocation_alignment) <>
                        composite.section_definition.allocation_offset DO
                    current_sequence_position := current_sequence_position + 1;
                  WHILEND;
                  pmp$position_object_library (preset_segment [preset_value].sequence_pointer,
                        current_sequence_position, valid_position);
                  IF NOT valid_position THEN
                    osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
                    RETURN;
                  IFEND;

                  old_section := composite.old_sections.link;
                  old := old_section^.component^.section_definitions^ [old_section^.section_ordinal];

                  NEXT composite.section_ptr: [0 .. old^.allotted_section_length - 1] IN
                        preset_segment [preset_value].sequence_pointer;
                  IF (composite.section_ptr = NIL) THEN
                    osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '944', status);
                    RETURN;
                  IFEND;

                  tir := old^.text_insertion_records.link;
                  length := #SIZE (tir^.text^.byte);

{ Fill in whatever part of the section has been initialized.  The remainder
{ defaults to the preset value for the bound module.

                  i#move (#LOC (tir^.text^.byte), #LOC (composite.section_ptr^), length);
                PROCEND collect_allotted_rw_sections;
?? OLDTITLE ??
?? NEWTITLE := '              COLLECT_TEXT_INSERTION_RECORDS', EJECT ??

                PROCEDURE collect_text_insertion_records
                  (VAR composite: oct$section_definition_list;
                   VAR status: ost$status);


                  VAR
                    old_section: ^oct$old_section_list,
                    old: ^oct$section_definition,
                    text: ^oct$text_insertion_list,
                    last_record: ^oct$text_insertion_list;


                  old_section := composite.old_sections.link;
                  last_record := ^composite.text_insertion_records;

                  WHILE old_section <> NIL DO
                    old := old_section^.component^.section_definitions^ [old_section^.section_ordinal];

                    IF old^.text <> NIL THEN
                      NEXT text IN segment_2;
                      IF text = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                        RETURN;
                      IFEND;

                      text^.kind := llc$text;
                      text^.link := NIL;

                      NEXT text^.text: [1 .. old^.section_definition.length] IN segment_1;
                      IF text^.text = NIL THEN
                        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                        RETURN;
                      IFEND;

                      text^.offset := 0;
                      text^.bit_offset := 0;
                      text^.length := old^.section_definition.length;
                      text^.starting_bit_offset := 0;
                      text^.ending_bit_offset := 0 + (8 * text^.length) - 1;
                      text^.overlapped := FALSE;
                      text^.text^.section_ordinal := old^.section_definition.section_ordinal;
                      text^.text^.offset := 0;
                      text^.text^.byte := old^.text^;
                      old^.text_insertion_records.link := text;
                    IFEND;

                    last_record^.link := old^.text_insertion_records.link;

                    WHILE last_record^.link <> NIL DO
                      last_record := last_record^.link;

                      last_record^.offset := last_record^.offset + old^.new_section_offset;
                      last_record^.starting_bit_offset := last_record^.starting_bit_offset +
                            (8 * old^.new_section_offset);
                      last_record^.ending_bit_offset := last_record^.ending_bit_offset +
                            (8 * old^.new_section_offset);
                    WHILEND;

                    old_section := old_section^.link;
                  WHILEND;


                PROCEND collect_text_insertion_records;
?? OLDTITLE ??
?? NEWTITLE := '              PACK_TEXT_INSERTION_RECORDS', EJECT ??

                PROCEDURE pack_text_insertion_records
                  (VAR composite: oct$section_definition_list;
                   VAR status: ost$status);


?? NEWTITLE := 'pack_text_records', EJECT ??

                  PROCEDURE pack_text_records
                    (VAR last_record: ^oct$text_insertion_list;
                     VAR last_text_insertion_record: ^oct$text_insertion_list;
                     VAR status: ost$status);

                    VAR
                      current_sequence_position: ost$segment_offset,
                      i: ost$segment_length,
                      length: ost$segment_length,
                      next_record: ^oct$text_insertion_list,
                      offset: ost$segment_offset,
                      preset_value: pmt$initialization_value,
                      valid_position: boolean;

                    preset_value := bound_module.preset_value;
                    initialize_preset_segment (preset_value, status);
                    IF NOT status.normal THEN
                      RETURN;
                    IFEND;


                    offset := last_record^.offset;
                    length := last_record^.length;
                    next_record := last_record^.link;

                  /loop/
                    WHILE (next_record <> NIL) AND (next_record^.kind = llc$text) DO
                      IF next_record^.offset < offset THEN
                        IF (next_record^.offset + next_record^.length) >= offset THEN
                          IF (next_record^.offset + next_record^.length) >= (offset + length) THEN
                            length := next_record^.length;
                          ELSE
                            length := (offset + length) - next_record^.offset;
                          IFEND;
                          offset := next_record^.offset;
                        ELSE
                          EXIT /loop/;
                        IFEND;

                      ELSEIF next_record^.offset <= (offset + length) THEN
                        IF (offset + length) < (next_record^.offset + next_record^.length) THEN
                          length := (next_record^.offset + next_record^.length) - offset;
                        IFEND;

{ If the user did not supply a preset value on the create_module request, do not
{ force non-adjacent text records together.  That is, keep the records distinct to
{ allow the flexibility of specifying preset value at execution or link time.

                      ELSEIF (bound_module.preset_specified) AND (next_record^.offset >= highest_offset) AND
                            ((next_record^.offset) <= (offset + length + 24)) THEN
                        IF (offset + length) < (next_record^.offset + next_record^.length) THEN
                          length := (next_record^.offset + next_record^.length) - offset;
                        IFEND;

                      ELSE
                        EXIT /loop/;
                      IFEND;

                      next_record := next_record^.link;
                    WHILEND /loop/;

                    NEXT last_text_insertion_record^.link IN segment_2;
                    last_text_insertion_record := last_text_insertion_record^.link;
                    IF last_text_insertion_record = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                      RETURN;
                    IFEND;

                    last_text_insertion_record^.offset := offset;
                    last_text_insertion_record^.bit_offset := 0;
                    last_text_insertion_record^.length := length;
                    last_text_insertion_record^.starting_bit_offset := (8 * offset);
                    last_text_insertion_record^.ending_bit_offset :=
                          last_text_insertion_record^.starting_bit_offset + (8 * length) - 1;
                    last_text_insertion_record^.kind := llc$text;
                    last_text_insertion_record^.link := NIL;

                    current_sequence_position := i#current_sequence_position
                          (preset_segment [preset_value].sequence_pointer);
                    WHILE (current_sequence_position MOD composite.section_definition.allocation_alignment) <>
                          composite.section_definition.allocation_offset DO
                      current_sequence_position := current_sequence_position + 1;
                    WHILEND;

{ Offset the start of the data for the text record in the preset value segment according
{ the new nearest word offset.  The full offset does not need to be considered.  The
{ calculation is based on the position of the 'BYTE' field in the type llt$text.

{ WARNING!!!  - This code is based on the type llt$text not being changed.  It assumes
{  TYPE
{    llt$text = record
{      section_ordinal: llt$section_ordinal,
{      offset: llt$section_offset,
{      byte: array [1 .. *] of 0..255,
{    recend;

                    WHILE ((current_sequence_position MOD 8) <> ((last_text_insertion_record^.offset -
                          #SIZE (llt$section_ordinal) - #SIZE (llt$section_offset) + 8) MOD 8)) DO
                      current_sequence_position := current_sequence_position + 1;
                    WHILEND;
                    pmp$position_object_library (preset_segment [preset_value].sequence_pointer,
                          current_sequence_position, valid_position);
                    IF NOT valid_position THEN
                      osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
                      RETURN;
                    IFEND;

                    NEXT last_text_insertion_record^.text: [1 .. length] IN
                          preset_segment [preset_value].sequence_pointer;
                    IF last_text_insertion_record^.text = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                      RETURN;
                    IFEND;

                    last_text_insertion_record^.text^.section_ordinal :=
                          composite.section_definition.section_ordinal;
                    last_text_insertion_record^.text^.offset := offset;

{ Anything that is not initialized will be based on the preset value in the resulting
{ packed record.

                    REPEAT
                      i#move (#LOC (last_record^.text^.byte), #LOC (last_text_insertion_record^.text^.
                            byte [(last_record^.offset - offset + 1)]), UPPERBOUND (last_record^.text^.byte));

                      last_record := last_record^.link;
                    UNTIL last_record = next_record;

                    IF (offset + length) > highest_offset THEN
                      highest_offset := offset + length;
                    IFEND;


                  PROCEND pack_text_records;
?? OLDTITLE ??
?? NEWTITLE := '                ADD_REPLICATION_RECORD', EJECT ??

                  PROCEDURE add_replication_record
                    (VAR last_record: ^oct$text_insertion_list;
                     VAR last_text_insertion_record: ^oct$text_insertion_list;
                     VAR status: ost$status);


                    NEXT last_text_insertion_record^.link IN segment_2;
                    last_text_insertion_record := last_text_insertion_record^.link;
                    IF last_text_insertion_record = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                      RETURN;
                    IFEND;

                    last_text_insertion_record^ := last_record^;
                    last_text_insertion_record^.link := NIL;


                    NEXT last_text_insertion_record^.replication:
                          [1 .. UPPERBOUND (last_record^.replication^.byte)] IN segment_1;
                    IF last_text_insertion_record^.replication = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                      RETURN;
                    IFEND;

                    last_text_insertion_record^.replication^ := last_record^.replication^;
                    last_text_insertion_record^.replication^.section_ordinal :=
                          composite.section_definition.section_ordinal;
                    last_text_insertion_record^.replication^.offset := last_record^.offset;


                    IF (last_record^.offset + last_record^.length) > highest_offset THEN
                      highest_offset := last_record^.offset + last_record^.length;
                    IFEND;


                    last_record := last_record^.link;


                  PROCEND add_replication_record;
?? OLDTITLE ??
?? NEWTITLE := '                ADD_BIT_STRING_INSERTION_RECORD', EJECT ??

                  PROCEDURE add_bit_string_insertion_record
                    (VAR last_record: ^oct$text_insertion_list;
                     VAR last_text_insertion_record: ^oct$text_insertion_list;
                     VAR status: ost$status);


                    NEXT last_text_insertion_record^.link IN segment_2;
                    last_text_insertion_record := last_text_insertion_record^.link;
                    IF last_text_insertion_record = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                      RETURN;
                    IFEND;

                    last_text_insertion_record^ := last_record^;
                    last_text_insertion_record^.link := NIL;


                    NEXT last_text_insertion_record^.bit_string_insertion IN segment_1;
                    IF last_text_insertion_record^.bit_string_insertion = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                      RETURN;
                    IFEND;

                    last_text_insertion_record^.bit_string_insertion^ := last_record^.bit_string_insertion^;
                    last_text_insertion_record^.bit_string_insertion^.section_ordinal :=
                          composite.section_definition.section_ordinal;
                    last_text_insertion_record^.bit_string_insertion^.offset := last_record^.offset;


                    IF (last_record^.offset + last_record^.length) > highest_offset THEN
                      highest_offset := last_record^.offset + last_record^.length;
                    IFEND;


                    last_record := last_record^.link;


                  PROCEND add_bit_string_insertion_record;
?? OLDTITLE ??
?? EJECT ??


                  VAR
                    last_text_insertion_record: ^oct$text_insertion_list,
                    last_record: ^oct$text_insertion_list,
                    highest_offset: ost$segment_length;


                  last_record := composite.text_insertion_records.link;
                  last_text_insertion_record := ^composite.text_insertion_records;
                  last_text_insertion_record^.link := NIL;


                  highest_offset := 0;

                  WHILE last_record <> NIL DO

                    CASE last_record^.kind OF
                    = llc$text =
                      pack_text_records (last_record, last_text_insertion_record, status);
                    = llc$replication =
                      add_replication_record (last_record, last_text_insertion_record, status);
                    = llc$bit_string_insertion =
                      add_bit_string_insertion_record (last_record, last_text_insertion_record, status);
                    CASEND;

                    IF NOT status.normal THEN
                      RETURN;
                    IFEND;
                  WHILEND;


                PROCEND pack_text_insertion_records;
?? OLDTITLE ??
?? EJECT ??

                VAR
                  composite: ^oct$section_definition_list;


                composite := section_definitions.link;

                WHILE composite <> NIL DO
                  IF (composite^.section_definition.kind = llc$common_block) OR
                        (composite^.section_definition.kind = llc$extensible_common_block) THEN
                    update_common_section (composite^);
                  ELSE
                    update_section (composite^, status);
                    IF NOT status.normal THEN
                      RETURN;
                    IFEND;
                  IFEND;

                  IF composite^.allotted_section THEN
                    IF (composite^.allotted_section_length = 0) THEN
                      collect_allotted_sections (composite^, status);
                    ELSE
                      collect_allotted_rw_sections (composite^, status);
                    IFEND;
                    IF NOT status.normal THEN
                      RETURN;
                    IFEND;

                  ELSE
                    collect_text_insertion_records (composite^, status);
                    IF NOT status.normal THEN
                      RETURN;
                    IFEND;

                    pack_text_insertion_records (composite^, status);
                    IF NOT status.normal THEN
                      RETURN;
                    IFEND;
                  IFEND;

                  composite := composite^.link;
                WHILEND;


              PROCEND build_composite_sections;
?? OLDTITLE ??
?? NEWTITLE := '              COLLECT_MISCELLANEOUS_RECORDS', EJECT ??

              PROCEDURE collect_miscellaneous_records
                (    separated_components: ^oct$separated_components;
                 VAR miscellaneous_record_list: oct$object_record_list;
                 VAR status: ost$status);

?? NEWTITLE := '                RELOCATE_CYBIL_SYMBOL_TABLE', EJECT ??

                PROCEDURE relocate_cybil_symbol_table
                  (    sequence: ^SEQ ( * );
                   VAR status: ost$status);


                  VAR
                    symbol_table: ^SEQ ( * ),
                    j: integer,
                    item: ^array [1 .. * ] of cyt$debug_symbol_table_item,
                    number_of_items: integer,
                    ordinal: llt$section_ordinal,
                    offset: llt$section_offset,
                    symbol_table_pointer: ^cyt$debug_symbol_table,
                    valid_position: boolean;


                  symbol_table := sequence;

                  IF (#SIZE (symbol_table^) MOD #SIZE (cyt$debug_symbol_table_item)) <> 0 THEN
                    pmp$position_object_library (symbol_table, 41, valid_position);
                    IF NOT valid_position THEN
                      osp$set_status_abnormal (oc, oce$e_bad_symbol_table,
                            separated_components^ [i].header^.name, status);
                      RETURN;
                    IFEND;
                  ELSE
                    RESET symbol_table;
                  IFEND;

                  number_of_items := #SIZE (symbol_table^) DIV #SIZE (cyt$debug_symbol_table_item);

                  IF number_of_items > 0 THEN
                    NEXT item: [1 .. number_of_items] IN symbol_table;
                    IF item = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_bad_symbol_table,
                            separated_components^ [i].header^.name, status);
                      osp$append_status_integer (osc$status_parameter_delimiter, 0, 10, FALSE, status);
                      RETURN;
                    IFEND;

                    FOR j := 1 TO number_of_items DO
                      CASE item^ [j].symbol_type OF
                      = proc_kind =
                        check_section_ordinal_offset (item^ [j].proc_section_ordinal, item^ [j].proc_offset,
                              separated_components^ [i].section_definitions, separated_components^ [i].
                              header^.name, status);
                        IF NOT status.normal THEN
                          RETURN;
                        IFEND;

                        item^ [j].proc_offset := relocated_section_offset
                              (separated_components^ [i], item^ [j].proc_section_ordinal,
                              item^ [j].proc_offset);
                        relocated_section_ordinal (separated_components^ [i], item^ [j].proc_section_ordinal,
                              item^ [j].proc_section_ordinal);

                      = var_kind =
                        IF item^ [j].base = static_base THEN
                          check_section_ordinal_offset (item^ [j].var_section_ordinal, item^ [j].var_offset,
                                separated_components^ [i].section_definitions,
                                separated_components^ [i].header^.name, status);
                          IF NOT status.normal THEN
                            RETURN;
                          IFEND;

                          item^ [j].var_offset := relocated_section_offset
                                (separated_components^ [i], item^ [j].var_section_ordinal,
                                item^ [j].var_offset);
                          relocated_section_ordinal (separated_components^ [i], item^ [j].var_section_ordinal,
                                item^ [j].var_section_ordinal);
                        IFEND;

                      ELSE
                      CASEND;

                      IF NOT status.normal THEN
                        ocp$generate_message (status);
                        osp$set_status_abnormal (oc, oce$e_bad_symbol_table, separated_components^ [i].
                              header^.name, status);
                        osp$append_status_integer (osc$status_parameter_delimiter, j, 10, FALSE, status);
                        RETURN;
                      IFEND;
                    FOREND;
                  IFEND;


                PROCEND relocate_cybil_symbol_table;
?? OLDTITLE ??
?? NEWTITLE := '                RELOCATE_OBSOLETE_LINE_TABLE', EJECT ??

                PROCEDURE relocate_obsolete_line_table
                  (    obsolete_line_address_table: ^llt$obsolete_line_address_table);


                  VAR
                    j: 1 .. llc$max_line_adr_table_size;


                  FOR j := 1 TO UPPERBOUND (obsolete_line_address_table^.item) DO
                    check_section_ordinal_offset (obsolete_line_address_table^.item [j].section_ordinal,
                          obsolete_line_address_table^.item [j].offset,
                          separated_components^ [i].section_definitions,
                          separated_components^ [i].header^.name, status);
                    IF NOT status.normal THEN
                      RETURN;
                    IFEND;

                    obsolete_line_address_table^.item [j].offset :=
                          relocated_section_offset (separated_components^ [i],
                          obsolete_line_address_table^.item [j].section_ordinal,
                          obsolete_line_address_table^.item [j].offset);
                    relocated_section_ordinal (separated_components^ [i],
                          obsolete_line_address_table^.item [j].section_ordinal,
                          obsolete_line_address_table^.item [j].section_ordinal);
                  FOREND;


                PROCEND relocate_obsolete_line_table;
?? OLDTITLE ??
?? NEWTITLE := '                RELOCATE_DEBUG_SYMBOL_TABLE', EJECT ??

                PROCEDURE relocate_debug_symbol_table
                  (    sequence: ^SEQ ( * );
                   VAR status: ost$status);


                  VAR
                    symbol_table_sequence: ^SEQ ( * ),
                    j: integer,
                    symbol_table: ^llt$debug_symbol_table,
                    ordinal: llt$section_ordinal,
                    offset: llt$section_offset;


                  symbol_table_sequence := sequence;

                  RESET symbol_table_sequence;
                  NEXT symbol_table: [1 .. 1] IN symbol_table_sequence;
                  IF symbol_table = NIL THEN
                    osp$set_status_abnormal (oc, oce$e_bad_symbol_table,
                          separated_components^ [i].header^.name, status);
                    osp$append_status_integer (osc$status_parameter_delimiter, 0, 10, FALSE, status);
                    RETURN;
                  IFEND;

                  RESET symbol_table_sequence;
                  NEXT symbol_table: [1 .. symbol_table^.number_of_items] IN symbol_table_sequence;
                  IF symbol_table = NIL THEN
                    osp$set_status_abnormal (oc, oce$e_bad_symbol_table,
                          separated_components^ [i].header^.name, status);
                    osp$append_status_integer (osc$status_parameter_delimiter, 0, 10, FALSE, status);
                    RETURN;
                  IFEND;

                  FOR j := 1 TO symbol_table^.number_of_items DO
                    CASE symbol_table^.item [j].symbol_kind OF
                    = llc$proc_kind =
                      check_section_ordinal_offset (symbol_table^.item [j].proc_section_ordinal,
                            symbol_table^.item [j].proc_offset, separated_components^ [i].section_definitions,
                            separated_components^ [i].header^.name, status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;

                      symbol_table^.item [j].proc_offset := relocated_section_offset
                            (separated_components^ [i], symbol_table^.item [j].proc_section_ordinal,
                            symbol_table^.item [j].proc_offset);
                      relocated_section_ordinal (separated_components^ [i],
                            symbol_table^.item [j].proc_section_ordinal,
                            symbol_table^.item [j].proc_section_ordinal);

                    = llc$ftn_array_kind =
                      IF symbol_table^.item [j].ftn_array_base = llc$static_base THEN
                        check_section_ordinal_offset (symbol_table^.item [j].ftn_array_section_ordinal,
                              symbol_table^.item [j].ftn_array_offset,
                              separated_components^ [i].section_definitions, separated_components^ [i].
                              header^.name, status);
                        IF NOT status.normal THEN
                          RETURN;
                        IFEND;

                        symbol_table^.item [j].ftn_array_offset := relocated_section_offset (
                              separated_components^ [i], symbol_table^.item [j].ftn_array_section_ordinal,
                              symbol_table^.item [j].ftn_array_offset);
                        relocated_section_ordinal (separated_components^ [i],
                              symbol_table^.item [j].ftn_array_section_ordinal,
                              symbol_table^.item [j].ftn_array_section_ordinal);
                      IFEND;


                      check_section_ordinal_offset (symbol_table^.item [j].dimension_info_section_ordinal,
                            symbol_table^.item [j].dimension_info_offset,
                            separated_components^ [i].section_definitions,
                            separated_components^ [i].header^.name, status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;

                      symbol_table^.item [j].dimension_info_offset :=
                            relocated_section_offset (separated_components^ [i],
                            symbol_table^.item [j].dimension_info_section_ordinal,
                            symbol_table^.item [j].dimension_info_offset);
                      relocated_section_ordinal (separated_components^ [i],
                            symbol_table^.item [j].dimension_info_section_ordinal,
                            symbol_table^.item [j].dimension_info_section_ordinal);

                    = llc$namelist_group_kind =
                      check_section_ordinal_offset (symbol_table^.item [j].namelist_info_section_ordinal,
                            symbol_table^.item [j].namelist_info_offset,
                            separated_components^ [i].section_definitions,
                            separated_components^ [i].header^.name, status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;

                      symbol_table^.item [j].namelist_info_offset :=
                            relocated_section_offset (separated_components^ [i],
                            symbol_table^.item [j].namelist_info_section_ordinal,
                            symbol_table^.item [j].namelist_info_offset);
                      relocated_section_ordinal (separated_components^ [i],
                            symbol_table^.item [j].namelist_info_section_ordinal,
                            symbol_table^.item [j].namelist_info_section_ordinal);

                    = llc$label_kind =
                      check_section_ordinal_offset (symbol_table^.item [j].label_section_ordinal,
                            symbol_table^.item [j].label_offset, separated_components^ [i].
                            section_definitions, separated_components^ [i].header^.name, status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;

                      symbol_table^.item [j].label_offset := relocated_section_offset
                            (separated_components^ [i], symbol_table^.item [j].label_section_ordinal,
                            symbol_table^.item [j].label_offset);
                      relocated_section_ordinal (separated_components^ [i],
                            symbol_table^.item [j].label_section_ordinal,
                            symbol_table^.item [j].label_section_ordinal);

                    = llc$constant_kind =
                      IF symbol_table^.item [j].constant_kind = llc$long_constant THEN
                        check_section_ordinal_offset (symbol_table^.item [j].constant_section_ordinal,
                              symbol_table^.item [j].constant_offset, separated_components^ [i].
                              section_definitions, separated_components^ [i].header^.name, status);
                        IF NOT status.normal THEN
                          RETURN;
                        IFEND;

                        symbol_table^.item [j].constant_offset := relocated_section_offset (
                              separated_components^ [i], symbol_table^.item [j].constant_section_ordinal,
                              symbol_table^.item [j].constant_offset);
                        relocated_section_ordinal (separated_components^ [i],
                              symbol_table^.item [j].constant_section_ordinal,
                              symbol_table^.item [j].constant_section_ordinal);
                      IFEND;

                    = llc$pascal_with_kind =
                      check_section_ordinal_offset (symbol_table^.item [j].with_section_ordinal,
                            symbol_table^.item [j].with_offset, separated_components^ [i].section_definitions,
                            separated_components^ [i].header^.name, status);
                      IF NOT status.normal THEN
                        RETURN;
                      IFEND;

                      symbol_table^.item [j].with_offset := relocated_section_offset
                            (separated_components^ [i], symbol_table^.item [j].with_section_ordinal,
                            symbol_table^.item [j].with_offset);

                      relocated_section_ordinal (separated_components^ [i],
                            symbol_table^.item [j].with_section_ordinal,
                            symbol_table^.item [j].with_section_ordinal);

                    = llc$var_kind =
                      IF symbol_table^.item [j].var_base = llc$static_base THEN
                        check_section_ordinal_offset (symbol_table^.item [j].var_section_ordinal,
                              symbol_table^.item [j].var_offset, separated_components^ [i].
                              section_definitions, separated_components^ [i].header^.name, status);
                        IF NOT status.normal THEN
                          RETURN;
                        IFEND;

                        symbol_table^.item [j].var_offset := relocated_section_offset
                              (separated_components^ [i], symbol_table^.item [j].var_section_ordinal,
                              symbol_table^.item [j].var_offset);
                        relocated_section_ordinal (separated_components^ [i],
                              symbol_table^.item [j].var_section_ordinal,
                              symbol_table^.item [j].var_section_ordinal);
                      IFEND;

                    ELSE
                    CASEND;

                    IF NOT status.normal THEN
                      ocp$generate_message (status);
                      osp$set_status_abnormal (oc, oce$e_bad_symbol_table,
                            separated_components^ [i].header^.name, status);
                      osp$append_status_integer (osc$status_parameter_delimiter, j, 10, FALSE, status);
                      RETURN;
                    IFEND;
                  FOREND;


                PROCEND relocate_debug_symbol_table;
?? OLDTITLE ??
?? NEWTITLE := '                RELOCATE_LINE_TABLE', EJECT ??

                PROCEDURE relocate_line_table
                  (    line_address_table: ^llt$line_address_table);


                  VAR
                    j: 1 .. llc$max_line_adr_table_size;


                  FOR j := 1 TO UPPERBOUND (line_address_table^.item) DO
                    check_section_ordinal_offset (line_address_table^.item [j].section_ordinal,
                          line_address_table^.item [j].offset, separated_components^ [i].section_definitions,
                          separated_components^ [i].header^.name, status);
                    IF NOT status.normal THEN
                      RETURN;
                    IFEND;

                    line_address_table^.item [j].offset := relocated_section_offset
                          (separated_components^ [i], line_address_table^.item [j].section_ordinal,
                          line_address_table^.item [j].offset);
                    relocated_section_ordinal (separated_components^ [i],
                          line_address_table^.item [j].section_ordinal,
                          line_address_table^.item [j].section_ordinal);
                  FOREND;


                PROCEND relocate_line_table;
?? OLDTITLE ??
?? EJECT ??


                VAR
                  i: integer,
                  last_misc: ^oct$object_record_list;


                last_misc := ^miscellaneous_record_list;

                FOR i := 1 TO UPPERBOUND (separated_components^) DO
                  last_misc^.link := separated_components^ [i].miscellaneous_record_list.link;

                  WHILE last_misc^.link <> NIL DO
                    last_misc := last_misc^.link;

                    CASE last_misc^.kind OF
                    = llc$symbol_table =
                      relocate_debug_symbol_table (^last_misc^.symbol_table^.text, status);
                    = llc$line_table =
                      relocate_line_table (last_misc^.line_address_table);
                    = llc$cybil_symbol_table_fragment =
                      relocate_cybil_symbol_table (^last_misc^.debug_table_fragment^.text, status);
                    = llc$obsolete_line_table =
                      relocate_obsolete_line_table (last_misc^.obsolete_line_address_table);
                    ELSE
                    CASEND;

                    IF NOT status.normal THEN
                      RETURN;
                    IFEND;
                  WHILEND;
                FOREND;


              PROCEND collect_miscellaneous_records;
?? OLDTITLE ??
?? NEWTITLE := '              QUICK_BIND_MODULE' ??
?? EJECT ??

              PROCEDURE quick_bind_module
                (    components: ^oct$separated_components;
                 VAR temporary_module_header: ^oct$temporary_module_header;
                 VAR status: ost$status);


?? NEWTITLE := '                COMBINE_EXT_RECORDS' ??
?? EJECT ??

                PROCEDURE combine_ext_records
                  (VAR old_external_linkage_list: ^oct$external_linkage_list;
                   VAR status: ost$status);


                  VAR
                    new_external_linkage_list: ^oct$external_linkage_list,
                    new_external_linkage: ^^oct$external_linkage_list,
                    old_external_linkage: ^^oct$external_linkage_list,
                    number_of_items: integer,
                    number: integer,
                    items: ^array [1 .. * ] of llt$external_linkage_item,
                    new_actual_parameter: ^oct$actual_parameter_list;



                  new_external_linkage_list := NIL;
                  new_external_linkage := ^new_external_linkage_list;

                  WHILE old_external_linkage_list <> NIL DO
                    number := UPPERBOUND (old_external_linkage_list^.external_linkage.item);
                    NEXT new_external_linkage^: [1 .. number] IN ocv$olg_scratch_seq;
                    IF new_external_linkage^ = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                      RETURN;
                    IFEND;

                    new_external_linkage^^.external_linkage := old_external_linkage_list^.external_linkage;
                    new_external_linkage^^.actual_parameter_list :=
                          old_external_linkage_list^.actual_parameter_list;

                    new_actual_parameter := ^new_external_linkage^^.actual_parameter_list;
                    old_external_linkage := ^old_external_linkage_list;
                    old_external_linkage_list := old_external_linkage_list^.link;

                    number_of_items := number;

                    WHILE old_external_linkage^ <> NIL DO
                      IF (old_external_linkage^^.external_linkage.name =
                            new_external_linkage^^.external_linkage.name) THEN

                        number := UPPERBOUND (old_external_linkage^^.external_linkage.item);

                        IF ((number_of_items + number) <= llc$max_ext_items) THEN
                          NEXT items: [1 .. number] IN ocv$olg_scratch_seq;
                          IF items = NIL THEN
                            osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                            RETURN;
                          IFEND;

                          number_of_items := number_of_items + number;
                          items^ := old_external_linkage^^.external_linkage.item;

                          IF old_external_linkage^^.actual_parameter_list.nnext <> NIL THEN
                            WHILE new_actual_parameter^.nnext <> NIL DO
                              new_actual_parameter := new_actual_parameter^.nnext;
                            WHILEND;
                            new_actual_parameter^.nnext := old_external_linkage^^.actual_parameter_list.nnext;
                          IFEND;

                          old_external_linkage^ := old_external_linkage^^.link;
                        ELSE
                          old_external_linkage := ^old_external_linkage^^.link;
                        IFEND;
                      ELSE
                        old_external_linkage := ^old_external_linkage^^.link;
                      IFEND;
                    WHILEND;

                    RESET ocv$olg_scratch_seq TO new_external_linkage^;
                    NEXT new_external_linkage^: [1 .. number_of_items] IN ocv$olg_scratch_seq;

                    new_external_linkage := ^new_external_linkage^^.link;

                  WHILEND;

                  old_external_linkage_list := new_external_linkage_list;
                  new_external_linkage^ := NIL;

                PROCEND combine_ext_records;
?? OLDTITLE ??
?? NEWTITLE := '                COMBINE_ADR_RECORDS' ??
?? EJECT ??

                PROCEDURE combine_adr_records
                  (VAR old_address_formulation_list: ^oct$address_formulation_list;
                   VAR status: ost$status);


                  VAR
                    new_address_formulation_list: ^oct$address_formulation_list,
                    new_address_formulation: ^^oct$address_formulation_list,
                    old_address_formulation: ^^oct$address_formulation_list,

                    number_of_items: integer,
                    number: integer,
                    items: ^array [1 .. * ] of llt$address_formulation_item;



                  new_address_formulation_list := NIL;
                  new_address_formulation := ^new_address_formulation_list;

                  WHILE old_address_formulation_list <> NIL DO
                    number := UPPERBOUND (old_address_formulation_list^.address_formulation.item);
                    NEXT new_address_formulation^: [1 .. number] IN ocv$olg_scratch_seq;
                    IF new_address_formulation^ = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                      RETURN;
                    IFEND;

                    new_address_formulation^^.address_formulation :=
                          old_address_formulation_list^.address_formulation;

                    old_address_formulation := ^old_address_formulation_list;
                    old_address_formulation_list := old_address_formulation_list^.link;

                    number_of_items := number;

                    WHILE old_address_formulation^ <> NIL DO
                      IF (old_address_formulation^^.address_formulation.value_section =
                            new_address_formulation^^.address_formulation.value_section) AND
                            (old_address_formulation^^.address_formulation.dest_section =
                            new_address_formulation^^.address_formulation.dest_section) THEN

                        number := UPPERBOUND (old_address_formulation^^.address_formulation.item);

                        IF ((number + number_of_items) <= llc$max_adr_items) THEN
                          NEXT items: [1 .. number] IN ocv$olg_scratch_seq;
                          IF items = NIL THEN
                            osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                            RETURN;
                          IFEND;

                          number_of_items := number_of_items + number;
                          items^ := old_address_formulation^^.address_formulation.item;
                          old_address_formulation^ := old_address_formulation^^.link;
                        ELSE
                          old_address_formulation := ^old_address_formulation^^.link;
                        IFEND;
                      ELSE
                        old_address_formulation := ^old_address_formulation^^.link;
                      IFEND;
                    WHILEND;

                    RESET ocv$olg_scratch_seq TO new_address_formulation^;
                    NEXT new_address_formulation^: [1 .. number_of_items] IN ocv$olg_scratch_seq;

                    new_address_formulation := ^new_address_formulation^^.link;

                  WHILEND;

                  old_address_formulation_list := new_address_formulation_list;
                  new_address_formulation^ := NIL;

                PROCEND combine_adr_records;
?? OLDTITLE ??
?? NEWTITLE := '                COLLECT_RELOCATION_RECORDS' ??
?? EJECT ??

                PROCEDURE collect_relocation_records
                  (VAR relocation: ^oct$relocation_item_list;
                   VAR number_of_rel_items: llt$number_of_info_elements;
                   VAR item: ^oct$relocation_list;
                   VAR status: ost$status);


                  status.normal := TRUE;

                  WHILE relocation <> NIL DO
                    number_of_rel_items := number_of_rel_items + 1;

                    NEXT item^.link IN ocv$olg_scratch_seq;
                    item := item^.link;
                    IF item = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                      RETURN;
                    IFEND;

                    item^.link := NIL;
                    item^.relocation_item := relocation^.item^;

                    item^.relocation_item.offset := relocated_section_offset
                          (component, item^.relocation_item.section_ordinal, item^.relocation_item.offset);
                    relocated_section_ordinal (component, item^.relocation_item.section_ordinal,
                          item^.relocation_item.section_ordinal);
                    relocated_section_ordinal (component, item^.relocation_item.relocating_section,
                          item^.relocation_item.relocating_section);

                    relocation := relocation^.link;
                  WHILEND;
                PROCEND collect_relocation_records;
?? OLDTITLE, EJECT ??

                VAR
                  component: oct$separated_module_header,

                  entry_definition: ^oct$entry_definition_list,
                  old_entry_definition: ^oct$entry_definition_list,
                  external: ^oct$external_linkage_list,
                  address: ^oct$address_formulation_list,

                  relocation: ^oct$relocation_item_list,
                  i: integer,
                  j: llt$number_of_info_elements,
                  item: ^oct$relocation_list,

                  new_item: ^oct$new_binding_template_list;


                component := components^ [1];


                temporary_module_header^.number_of_entry_definitions := 0;
                entry_definition := ^temporary_module_header^.entry_definition_list;
                old_entry_definition := component.entry_definition_list.link;

                WHILE old_entry_definition <> NIL DO
                  IF old_entry_definition^.changed_name^ <> osc$null_name THEN
                    temporary_module_header^.number_of_entry_definitions :=
                          temporary_module_header^.number_of_entry_definitions + 1;

                    entry_definition^.link := old_entry_definition;
                    entry_definition := entry_definition^.link;

                    entry_definition^.entry_definition.offset := relocated_section_offset
                          (component, entry_definition^.entry_definition.section_ordinal,
                          entry_definition^.entry_definition.offset);
                    relocated_section_ordinal (component, entry_definition^.entry_definition.section_ordinal,
                          entry_definition^.entry_definition.section_ordinal);

                    entry_definition^.entry_definition.name := entry_definition^.changed_name^;
                  IFEND;

                  old_entry_definition := old_entry_definition^.link;
                WHILEND;

                entry_definition^.link := NIL;

                temporary_module_header^.deferred_entry_points := component.deferred_entry_points;
                IF temporary_module_header^.deferred_entry_points <> NIL THEN
                  FOR i := 1 TO UPPERBOUND (temporary_module_header^.deferred_entry_points^) DO
                    relocated_section_ordinal (component, temporary_module_header^.deferred_entry_points^ [i].
                          section_ordinal, temporary_module_header^.deferred_entry_points^ [i].
                          section_ordinal);
                  FOREND;
                IFEND;

                temporary_module_header^.external_linkage_list := component.external_linkage_list;

                external := temporary_module_header^.external_linkage_list;

                WHILE external <> NIL DO
                  FOR i := 1 TO UPPERBOUND (external^.external_linkage.item) DO
                    external^.external_linkage.item [i].offset :=
                          relocated_section_offset (component, external^.external_linkage.item [i].
                          section_ordinal, external^.external_linkage.item [i].offset);
                    relocated_section_ordinal (component, external^.external_linkage.item [i].section_ordinal,
                          external^.external_linkage.item [i].section_ordinal);
                  FOREND;

                  external := external^.link;
                WHILEND;

                combine_ext_records (temporary_module_header^.external_linkage_list, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;

                temporary_module_header^.address_formulation_list := component.address_formulation_list;

                address := temporary_module_header^.address_formulation_list;

                WHILE address <> NIL DO
                  FOR i := 1 TO UPPERBOUND (address^.address_formulation.item) DO
                    address^.address_formulation.item [i].value_offset :=
                          relocated_section_offset (component, address^.address_formulation.value_section,
                          address^.address_formulation.item [i].value_offset);
                    address^.address_formulation.item [i].dest_offset :=
                          relocated_section_offset (component, address^.address_formulation.dest_section,
                          address^.address_formulation.item [i].dest_offset);
                  FOREND;

                  relocated_section_ordinal (component, address^.address_formulation.value_section,
                        address^.address_formulation.value_section);
                  relocated_section_ordinal (component, address^.address_formulation.dest_section,
                        address^.address_formulation.dest_section);

                  address := address^.link;
                WHILEND;

                combine_adr_records (temporary_module_header^.address_formulation_list, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;

                collect_miscellaneous_records (components, temporary_module_header^.miscellaneous_record_list,
                      status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;

                temporary_module_header^.number_of_rel_items := 0;
                item := ^temporary_module_header^.relocation_list;

                collect_relocation_records (component.relocation_list.byte.link,
                      temporary_module_header^.number_of_rel_items, item, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;

                collect_relocation_records (component.relocation_list.two_byte.link,
                      temporary_module_header^.number_of_rel_items, item, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;

                collect_relocation_records (component.relocation_list.four_byte.link,
                      temporary_module_header^.number_of_rel_items, item, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;

                collect_relocation_records (component.relocation_list.eight_byte.link,
                      temporary_module_header^.number_of_rel_items, item, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;

                temporary_module_header^.number_of_template_items := component.number_of_template_items;

                new_item := ^temporary_module_header^.binding_template_list;
                j := 0;
                FOR i := 1 TO temporary_module_header^.number_of_template_items DO
                  WHILE component.binding_template_list^ [j].binding_template = NIL DO
                    j := j + 1;
                  WHILEND;

                  NEXT new_item^.link IN ocv$olg_scratch_seq;
                  new_item := new_item^.link;
                  IF new_item = NIL THEN
                    osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                    RETURN;
                  IFEND;

                  new_item^.link := NIL;
                  new_item^.binding_template := component.binding_template_list^ [j].binding_template^;

                  IF new_item^.binding_template.kind = llc$current_module THEN
                    new_item^.binding_template.offset := new_item^.binding_template.offset +
                          component.section_definitions^ [new_item^.binding_template.section_ordinal]^.
                          new_section_offset;
                    new_item^.binding_template.section_ordinal := component.
                          section_definitions^ [new_item^.binding_template.section_ordinal]^.new^.
                          section_definition.section_ordinal;

                  IFEND;
                  j := j + 1;
                FOREND;

              PROCEND quick_bind_module;
?? OLDTITLE ??
?? NEWTITLE := '              BIND_MODULE', EJECT ??

              PROCEDURE bind_module
                (    separated_components: ^oct$separated_components;
                 VAR temporary_module_header: ^oct$temporary_module_header;
                 VAR status: ost$status);


?? NEWTITLE := '                GET_OLD_BINDING_TEMPLATE_ITEM' ??
?? EJECT ??

                PROCEDURE [INLINE] get_old_binding_template_item
                  (    component: oct$separated_module_header;
                       offset: llt$section_offset;
                   VAR old_binding_template_item: ^oct$old_binding_template_item;
                   VAR status: ost$status);


                  VAR
                    bti: llt$binding_template;


                  old_binding_template_item := ^component.binding_template_list^ [offset DIV 8];

                  IF old_binding_template_item^.binding_template <> NIL THEN
                    bti := old_binding_template_item^.binding_template^;
                    IF bti.binding_offset = offset THEN
                      RETURN;

                    ELSEIF (bti.binding_offset - 2) = offset THEN
                      CASE bti.kind OF
                      = llc$current_module =
                        IF bti.internal_address = llc$address THEN
                          RETURN;
                        IFEND;
                      = llc$external_reference =
                        IF (bti.address = llc$address) OR (bti.address = llc$address_addition) OR
                              (bti.address = llc$address_subtraction) THEN
                          RETURN;
                        IFEND;
                      CASEND;

                    IFEND;
                  IFEND;

                  osp$set_status_abnormal (oc, oce$e_bad_binding_sec_offset, component.header^.name, status);

                PROCEND get_old_binding_template_item;
?? OLDTITLE ??
?? NEWTITLE := '                ADD_TO_ENTRY_POINT_ADDRESS_TREE', EJECT ??

                PROCEDURE build_entry_point_sorted_list
                  (    number_of_entry_points: llt$entry_point_index;
                       first_entry_point_address_item: ^oct$entry_point_address_list;
                   VAR entry_point_sorted_list: oct$entry_point_sorted_list;
                   VAR status: ost$status);

                  VAR
                    entry_point_address_item: ^oct$entry_point_address_list,
                    found: boolean,
                    hi: llt$entry_point_index,
                    i: llt$entry_point_index,
                    insert: llt$entry_point_index,
                    k: llt$entry_point_index,
                    lo: llt$entry_point_index,
                    mid: llt$entry_point_index,
                    temp: integer,
                    sorted_list_size: llt$entry_point_index;


                  entry_point_address_item := first_entry_point_address_item;
                  sorted_list_size := 0;

                  NEXT entry_point_sorted_list: [1 .. number_of_entry_points] IN ocv$olg_scratch_seq;
                  IF entry_point_sorted_list = NIL THEN
                    osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                    RETURN;
                  IFEND;

                  FOR k := 1 TO number_of_entry_points DO
                    hi := sorted_list_size;
                    found := FALSE;
                    lo := 1;

                    WHILE (lo <= hi) AND NOT found DO
                      temp := lo + hi;
                      mid := temp DIV 2;
                      IF entry_point_address_item^.name = entry_point_sorted_list^ [mid]^.name THEN
                        found := TRUE;
                      ELSEIF entry_point_address_item^.name < entry_point_sorted_list^ [mid]^.name THEN
                        hi := mid - 1;
                      ELSE
                        lo := mid + 1;
                      IFEND;
                    WHILEND;

                    IF found THEN
                      insert := mid;
                    ELSE
                      insert := lo;
                    IFEND;

                    sorted_list_size := sorted_list_size + 1;

                    FOR i := (sorted_list_size - 1) DOWNTO insert DO
                      entry_point_sorted_list^ [i + 1] := entry_point_sorted_list^ [i];
                    FOREND;

                    entry_point_sorted_list^ [insert] := entry_point_address_item;

                    entry_point_address_item := entry_point_address_item^.link;
                  FOREND;

                PROCEND build_entry_point_sorted_list;
?? OLDTITLE ??
?? NEWTITLE := '                SEARCH_ENTRY_POINT_ADDRESS_LIST' ??
?? EJECT ??

                PROCEDURE [INLINE] search_entry_point_sorted_list
                  (    name: pmt$program_name;
                   VAR name_found: boolean;
                   VAR entry_point_address_item: ^oct$entry_point_address_list);

                  VAR
                    temp: integer,
                    hi: llt$entry_point_index,
                    lo: llt$entry_point_index,
                    mid: llt$entry_point_index;

                  hi := UPPERBOUND (entry_point_sorted_list^);
                  lo := 1;
                  name_found := FALSE;

                  WHILE (lo <= hi) AND NOT name_found DO
                    temp := lo + hi;
                    mid := temp DIV 2;
                    IF name = entry_point_sorted_list^ [mid]^.name THEN
                      name_found := TRUE;
                      entry_point_address_item := entry_point_sorted_list^ [mid];
                    ELSEIF name < entry_point_sorted_list^ [mid]^.name THEN
                      hi := mid - 1;
                    ELSE
                      lo := mid + 1;
                    IFEND;
                  WHILEND;

                PROCEND search_entry_point_sorted_list;
?? OLDTITLE ??
?? NEWTITLE := '                BUILD_NEW_ADR_RECORD' ??
?? EJECT ??

                PROCEDURE build_new_adr_record
                  (    destination_section_ordinal: llt$section_ordinal;
                       destination_offset: llt$section_offset;
                       value_section_ordinal: llt$section_ordinal;
                       value_offset: ost$segment_offset;
                       kind: llt$address_kind;
                       offset_operand: llt$section_address_range;
                   VAR status: ost$status);



                  NEXT ocv$last_new_adr_formulation^.link IN ocv$olg_scratch_seq;
                  ocv$last_new_adr_formulation := ocv$last_new_adr_formulation^.link;
                  IF ocv$last_new_adr_formulation = NIL THEN
                    osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                    RETURN;
                  IFEND;

                  ocv$last_new_adr_formulation^.link := NIL;
                  ocv$last_new_adr_formulation^.value_section := value_section_ordinal;
                  ocv$last_new_adr_formulation^.dest_section := destination_section_ordinal;
                  ocv$last_new_adr_formulation^.item.dest_offset := destination_offset;

                  IF kind = llc$address_addition THEN
                    ocv$last_new_adr_formulation^.item.value_offset := value_offset + offset_operand;
                    ocv$last_new_adr_formulation^.item.kind := llc$address;
                  ELSEIF kind = llc$address_subtraction THEN
                    ocv$last_new_adr_formulation^.item.value_offset := value_offset - offset_operand;
                    ocv$last_new_adr_formulation^.item.kind := llc$address;
                  ELSE
                    ocv$last_new_adr_formulation^.item.value_offset := value_offset;
                    ocv$last_new_adr_formulation^.item.kind := kind;
                  IFEND;



                PROCEND build_new_adr_record;
?? OLDTITLE ??
?? NEWTITLE := '                BUILD_NEW_EXT_RECORD' ??
?? EJECT ??

                PROCEDURE build_new_ext_record
                  (    external_linkage: ^oct$external_linkage_list;
                       value_section_ordinal: llt$section_ordinal;
                       value_offset: llt$section_offset;
                       address_kind: llt$address_kind;
                       offset_operand: llt$section_address_range;
                   VAR status: ost$status);



                  NEXT ocv$last_new_external^.link IN ocv$olg_scratch_seq;
                  ocv$last_new_external := ocv$last_new_external^.link;
                  IF ocv$last_new_external = NIL THEN
                    osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                    RETURN;
                  IFEND;

                  ocv$last_new_external^.link := NIL;
                  ocv$last_new_external^.name := external_linkage^.external_linkage.name;
                  ocv$last_new_external^.language := external_linkage^.external_linkage.language;
                  ocv$last_new_external^.declaration_matching_required :=
                        external_linkage^.external_linkage.declaration_matching_required;
                  ocv$last_new_external^.declaration_matching :=
                        external_linkage^.external_linkage.declaration_matching;
                  ocv$last_new_external^.item.section_ordinal := value_section_ordinal;
                  ocv$last_new_external^.item.offset := value_offset;
                  ocv$last_new_external^.item.kind := address_kind;
                  ocv$last_new_external^.item.offset_operand := offset_operand;
                  ocv$last_new_external^.actual_parameter_list := NIL;

                PROCEND build_new_ext_record;
?? OLDTITLE ??
?? NEWTITLE := '                  COMBINE_EXT_RECORDS' ??
?? EJECT ??

                PROCEDURE combine_ext_records
                  (VAR old_external_linkage_items: ^oct$external_linkage_item;
                   VAR new_external_linkage_list: ^oct$external_linkage_list;
                   VAR status: ost$status);


                  VAR
                    old_external_item: ^^oct$external_linkage_item,
                    last_new_external_linkage: ^^oct$external_linkage_list,
                    actual_parameter: ^oct$actual_parameter_list,
                    number_of_items: integer,
                    item: ^llt$external_linkage_item;


                  new_external_linkage_list := NIL;
                  last_new_external_linkage := ^new_external_linkage_list;

                  WHILE old_external_linkage_items <> NIL DO
                    NEXT last_new_external_linkage^: [1 .. 1] IN segment_3;
                    IF last_new_external_linkage^ = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                      RETURN;
                    IFEND;

                    last_new_external_linkage^^.external_linkage.name := old_external_linkage_items^.name;
                    last_new_external_linkage^^.external_linkage.language :=
                          old_external_linkage_items^.language;
                    last_new_external_linkage^^.external_linkage.declaration_matching_required :=
                          old_external_linkage_items^.declaration_matching_required;
                    last_new_external_linkage^^.external_linkage.declaration_matching :=
                          old_external_linkage_items^.declaration_matching;
                    last_new_external_linkage^^.external_linkage.item [1] := old_external_linkage_items^.item;
                    last_new_external_linkage^^.actual_parameter_list.nnext :=
                          old_external_linkage_items^.actual_parameter_list;
                    old_external_linkage_items := old_external_linkage_items^.link;
                    old_external_item := ^old_external_linkage_items;

                    number_of_items := 1;

                    WHILE old_external_item^ <> NIL DO
                      IF (old_external_item^^.name = last_new_external_linkage^^.external_linkage.name) AND
                            ((number_of_items + 1) <= llc$max_ext_items) THEN
                        NEXT item IN segment_3;
                        IF item = NIL THEN
                          osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                          RETURN;
                        IFEND;

                        IF old_external_item^^.actual_parameter_list <> NIL THEN
                          actual_parameter := old_external_item^^.actual_parameter_list;
                          WHILE actual_parameter^.nnext <> NIL DO
                            actual_parameter := actual_parameter^.nnext;
                          WHILEND;

                          actual_parameter^.nnext := last_new_external_linkage^^.actual_parameter_list.nnext;

                          last_new_external_linkage^^.actual_parameter_list.nnext :=
                                old_external_item^^.actual_parameter_list;
                        IFEND;

                        number_of_items := number_of_items + 1;
                        item^ := old_external_item^^.item;
                        old_external_item^ := old_external_item^^.link;
                      ELSE
                        old_external_item := ^old_external_item^^.link;
                      IFEND;
                    WHILEND;

                    IF number_of_items > 1 THEN
                      RESET segment_3 TO last_new_external_linkage^;
                      NEXT last_new_external_linkage^: [1 .. number_of_items] IN segment_3;
                    IFEND;

                    last_new_external_linkage := ^last_new_external_linkage^^.link;

                  WHILEND;

                  last_new_external_linkage^ := NIL;


                PROCEND combine_ext_records;
?? OLDTITLE ??
?? NEWTITLE := '                COMBINE_ADR_RECORDS' ??
?? EJECT ??

                PROCEDURE combine_adr_records
                  (VAR old_address_formulation_items: ^oct$address_formulation_item;
                   VAR new_address_formulation_list: ^oct$address_formulation_list;
                   VAR status: ost$status);


                  VAR
                    old_address_formulation_item: ^^oct$address_formulation_item,
                    last_new_address_formulation: ^^oct$address_formulation_list,

                    number_of_items: integer,
                    item: ^llt$address_formulation_item;



                  new_address_formulation_list := NIL;
                  last_new_address_formulation := ^new_address_formulation_list;

                  WHILE old_address_formulation_items <> NIL DO
                    NEXT last_new_address_formulation^: [1 .. 1] IN segment_3;
                    IF last_new_address_formulation^ = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                      RETURN;
                    IFEND;

                    last_new_address_formulation^^.address_formulation.dest_section :=
                          old_address_formulation_items^.dest_section;
                    last_new_address_formulation^^.address_formulation.value_section :=
                          old_address_formulation_items^.value_section;
                    last_new_address_formulation^^.address_formulation.item [1] :=
                          old_address_formulation_items^.item;

                    old_address_formulation_items := old_address_formulation_items^.link;
                    old_address_formulation_item := ^old_address_formulation_items;

                    number_of_items := 1;

                    WHILE old_address_formulation_item^ <> NIL DO
                      IF (old_address_formulation_item^^.value_section =
                            last_new_address_formulation^^.address_formulation.value_section) AND
                            (old_address_formulation_item^^.dest_section =
                            last_new_address_formulation^^.address_formulation.dest_section) AND
                            ((number_of_items + 1) <= llc$max_adr_items) THEN

                        NEXT item IN segment_3;
                        IF item = NIL THEN
                          osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                          RETURN;
                        IFEND;

                        number_of_items := number_of_items + 1;
                        item^ := old_address_formulation_item^^.item;
                        old_address_formulation_item^ := old_address_formulation_item^^.link;
                      ELSE
                        old_address_formulation_item := ^old_address_formulation_item^^.link;
                      IFEND;
                    WHILEND;

                    IF number_of_items > 1 THEN
                      RESET segment_3 TO last_new_address_formulation^;
                      NEXT last_new_address_formulation^: [1 .. number_of_items] IN segment_3;
                    IFEND;

                    last_new_address_formulation := ^last_new_address_formulation^^.link;

                  WHILEND;

                  last_new_address_formulation^ := NIL;


                PROCEND combine_adr_records;
?? OLDTITLE ??
?? NEWTITLE := '                GENERATE_BINDING_TEMPLATE_ITEM' ??
?? EJECT ??

                PROCEDURE generate_binding_template_item
                  (    component: oct$separated_module_header;
                       old_binding_template_offset: llt$section_offset;
                   VAR new_binding_section_offset: ost$segment_offset;
                   VAR status: ost$status);

?? NEWTITLE := '                  SEARCH_BINDING_TEMP_FOR_ADDRESS' ??
?? EJECT ??

                  PROCEDURE search_binding_temp_for_address
                    (    section_ordinal: llt$section_ordinal;
                         offset: ost$segment_offset;
                         internal_address: llt$internal_address_kind;
                     VAR binding_template_found: boolean;
                     VAR new_binding_section_offset: ost$segment_offset);



                    VAR
                      binding_template: ^oct$new_binding_template_list;



                    binding_template := temporary_module_header^.binding_template_list.link;

                    WHILE binding_template <> NIL DO
                      IF (binding_template^.binding_template.section_ordinal = section_ordinal) AND
                            (binding_template^.binding_template.offset = offset) AND
                            (binding_template^.binding_template.internal_address = internal_address) THEN

                        new_binding_section_offset := binding_template^.binding_template.binding_offset;
                        binding_template_found := TRUE;
                        RETURN;
                      IFEND;

                      binding_template := binding_template^.link;
                    WHILEND;

                    binding_template_found := FALSE;

                  PROCEND search_binding_temp_for_address;
?? OLDTITLE ??
?? NEWTITLE := '                  SEARCH_BINDING_TEMP_FOR_NAME' ??
?? EJECT ??

                  PROCEDURE search_binding_temp_for_name
                    (    name: pmt$program_name;
                         address: llt$address_kind;
                     VAR binding_template_found: boolean;
                     VAR new_binding_section_offset: ost$segment_offset);



                    VAR
                      binding_template: ^oct$new_binding_template_list;



                    binding_template := temporary_module_header^.binding_template_list.link;

                    WHILE binding_template <> NIL DO
                      IF (binding_template^.binding_template.name = name) AND
                            (binding_template^.binding_template.address = address) THEN
                        new_binding_section_offset := binding_template^.binding_template.binding_offset;
                        binding_template_found := TRUE;
                        RETURN;
                      IFEND;

                      binding_template := binding_template^.link;
                    WHILEND;

                    binding_template_found := FALSE;


                  PROCEND search_binding_temp_for_name;
?? OLDTITLE ??
?? NEWTITLE := '                  COMPUTE_NEW_BINDING_SEC_OFFSET' ??
?? EJECT ??

                  PROCEDURE [INLINE] compute_new_binding_sec_offset
                    (    address_kind: llt$address_kind;
                     VAR new_binding_section_offset: ost$segment_offset;
                     VAR status: ost$status);



                    CASE address_kind OF

                    = llc$address =
                      new_binding_section_offset := ocv$next_avail_binding_offset + 2;
                      ocv$next_avail_binding_offset := ocv$next_avail_binding_offset + 8;

                    = llc$internal_proc =
                      new_binding_section_offset := ocv$next_avail_binding_offset;
                      ocv$next_avail_binding_offset := ocv$next_avail_binding_offset + 8;

                    = llc$external_proc =
                      new_binding_section_offset := ocv$next_avail_binding_offset;
                      ocv$next_avail_binding_offset := ocv$next_avail_binding_offset + 16;

                    = llc$address_addition =
                      new_binding_section_offset := ocv$next_avail_binding_offset + 2;
                      ocv$next_avail_binding_offset := ocv$next_avail_binding_offset + 8;

                    = llc$address_subtraction =
                      new_binding_section_offset := ocv$next_avail_binding_offset + 2;
                      ocv$next_avail_binding_offset := ocv$next_avail_binding_offset + 8;

                    ELSE
                      osp$set_status_abnormal (oc, oce$e_invalid_address_kind, '', status);
                      RETURN;
                    CASEND;

                  PROCEND compute_new_binding_sec_offset;
?? OLDTITLE ??
?? NEWTITLE := '                  BUILD_CURRENT_TEMPLATE_ENTRY' ??
?? EJECT ??

                  PROCEDURE build_current_template_entry
                    (    address_kind: llt$address_kind;
                     VAR new_binding_section_offset: ost$segment_offset;
                     VAR status: ost$status);




                    NEXT ocv$last_new_binding_template^.link IN segment_1;
                    ocv$last_new_binding_template := ocv$last_new_binding_template^.link;
                    IF ocv$last_new_binding_template = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                      RETURN;
                    IFEND;

                    ocv$number_of_new_temp_items := ocv$number_of_new_temp_items + 1;

                    compute_new_binding_sec_offset (address_kind, new_binding_section_offset, status);
                    IF NOT status.normal THEN
                      RETURN;
                    IFEND;

                    ocv$last_new_binding_template^.link := NIL;
                    ocv$last_new_binding_template^.binding_template.binding_offset :=
                          new_binding_section_offset;
                    ocv$last_new_binding_template^.binding_template.kind := llc$current_module;
                    ocv$last_new_binding_template^.binding_template.internal_address := address_kind;
                    ocv$last_new_binding_template^.binding_template.section_ordinal := new_section_ordinal;
                    ocv$last_new_binding_template^.binding_template.offset := new_section_offset;

                  PROCEND build_current_template_entry;
?? OLDTITLE ??
?? NEWTITLE := '                  BUILD_EXTERNAL_TEMPLATE_ENTRY' ??
?? EJECT ??

                  PROCEDURE build_external_template_entry
                    (    old_binding_template_item: ^oct$old_binding_template_item;
                     VAR new_binding_section_offset: ost$segment_offset;
                     VAR status: ost$status);



                    NEXT ocv$last_new_binding_template^.link IN segment_1;
                    ocv$last_new_binding_template := ocv$last_new_binding_template^.link;
                    IF ocv$last_new_binding_template = NIL THEN
                      osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                      RETURN;
                    IFEND;

                    ocv$number_of_new_temp_items := ocv$number_of_new_temp_items + 1;

                    compute_new_binding_sec_offset (old_binding_template_item^.binding_template^.address,
                          new_binding_section_offset, status);
                    IF NOT status.normal THEN
                      RETURN;
                    IFEND;

                    ocv$last_new_binding_template^.link := NIL;
                    ocv$last_new_binding_template^.binding_template.binding_offset :=
                          new_binding_section_offset;
                    ocv$last_new_binding_template^.binding_template.kind := llc$external_reference;
                    ocv$last_new_binding_template^.binding_template.address :=
                          old_binding_template_item^.binding_template^.address;
                    ocv$last_new_binding_template^.binding_template.name :=
                          old_binding_template_item^.binding_template^.name;

                  PROCEND build_external_template_entry;
?? OLDTITLE ??
?? NEWTITLE := '                  FIND_OFFSET_OPERAND' ??
?? EJECT ??

{ The purpose of this procedure is to find an external linkage record with the correct
{ name and old_binding_template_offset and return the address_kind and offset_operand from it.
{ Note that there may be more than one external linkage record with the same name.

                  PROCEDURE find_offset_operand
                    (    name: pmt$program_name;
                         old_binding_template_offset: llt$section_offset;
                     VAR external_linkage: ^oct$external_linkage_list;
                     VAR address_kind: llt$address_kind;
                     VAR offset_operand: llt$section_address_range;
                     VAR status: ost$status);

                    VAR
                      binding_section_found: boolean,
                      binding_section_ordinal: llt$section_ordinal,
                      i: integer;

                    status.normal := TRUE;
                    binding_section_found := FALSE;
                    i := 0;

                  /find_binding_section/
                    WHILE (NOT binding_section_found) AND (i <= UPPERBOUND (component.section_definitions^))
                          DO
                      IF (component.section_definitions^ [i] = NIL) THEN
                        i := i + 1;
                        CYCLE /find_binding_section/;
                      IFEND;
                      IF component.section_definitions^ [i]^.section_definition.kind =
                            llc$binding_section THEN
                        binding_section_ordinal := component.section_definitions^ [i]^.section_definition.
                              section_ordinal;
                        binding_section_found := TRUE;
                      ELSE
                        i := i + 1;
                      IFEND;
                    WHILEND /find_binding_section/;

                    IF NOT binding_section_found THEN
                      osp$set_status_abnormal (oc, oce$e_bnd_sec_ext_not_found, component.header^.name,
                            status);
                      RETURN;
                    IFEND;

                    external_linkage := component.external_linkage_list;
                    WHILE (external_linkage <> NIL) DO
                      IF external_linkage^.external_linkage.name = name THEN
                        i := 1;
                        WHILE (i <= UPPERBOUND (external_linkage^.external_linkage.item)) DO
                          IF external_linkage^.external_linkage.item [i].section_ordinal =
                                binding_section_ordinal THEN
                            IF old_binding_template_offset = external_linkage^.external_linkage.item [i].
                                  offset THEN
                              address_kind := external_linkage^.external_linkage.item [i].kind;
                              offset_operand := external_linkage^.external_linkage.item [i].offset_operand;
                              RETURN;
                            ELSE
                              i := i + 1;
                            IFEND;
                          IFEND;
                        WHILEND;
                      IFEND;
                      external_linkage := external_linkage^.link;
                    WHILEND;

{ If we get here, then we searched the whole external_linkage list and didn't find the right name.

                    osp$set_status_abnormal (oc, oce$e_bnd_sec_ext_not_found, component.header^.name, status);

                  PROCEND find_offset_operand;
?? OLDTITLE ??
?? EJECT ??


                  VAR
                    address_kind: llt$address_kind,
                    offset_operand: llt$section_address_range,
                    external_found: boolean,
                    new_template_item_found: boolean,

                    entry_point_address_item: ^oct$entry_point_address_list,
                    external_linkage: ^oct$external_linkage_list,

                    new_section_ordinal: llt$section_ordinal,
                    new_section_offset: ost$segment_offset,

                    new_address_kind: llt$address_kind,
                    new_binding_template_item: ^oct$new_binding_template_list,
                    old_binding_template_item: ^oct$old_binding_template_item;



{ This routine is recursive in that it may call itself if the binding template
{item being
{ generated references the binding section. This may occur a number of times.
{Recursion is
{ necessary to accomodate chains of unreferenced pointers linked through the
{ binding section. A typical example of this is a statically initialized
{pointer to
{ procedure. It is highly unlikely that this will ever occur, however, it must
{ be considered.

                  get_old_binding_template_item (component, old_binding_template_offset,
                        old_binding_template_item, status);
                  IF NOT status.normal THEN
                    RETURN;
                  IFEND;

                  IF old_binding_template_item^.referenced_in_new_binding_sect THEN
                    new_binding_section_offset := old_binding_template_item^.new_binding_section_offset;
                    new_section_ordinal := ocv$new_binding_section_ordinal;
                    RETURN;

                  ELSE
                    CASE old_binding_template_item^.binding_template^.kind OF

                    = llc$current_module =

                      IF component.section_definitions^ [old_binding_template_item^.binding_template^.
                            section_ordinal]^.section_definition.kind = llc$binding_section THEN

{ Pointer stored in value address of the binding section points to another
{ binding section entry.

                        new_section_ordinal := ocv$new_binding_section_ordinal;
                        generate_binding_template_item (component, old_binding_template_item^.
                              binding_template^.binding_offset, new_section_offset, status);
                        IF NOT status.normal THEN
                          RETURN;
                        IFEND;
                      ELSE
                        relocated_section_ordinal (component, old_binding_template_item^.binding_template^.
                              section_ordinal, new_section_ordinal);
                        new_section_offset := relocated_section_offset
                              (component, old_binding_template_item^.binding_template^.section_ordinal,
                              old_binding_template_item^.binding_template^.offset);
                      IFEND;

{ Check if the new binding template already contains an entry with the corresponding
{ new_section ordinal and offset.

                      search_binding_temp_for_address (new_section_ordinal, new_section_offset,
                            old_binding_template_item^.binding_template^.internal_address,
                            new_template_item_found, new_binding_section_offset);

                      IF NOT new_template_item_found THEN
                        build_current_template_entry (old_binding_template_item^.binding_template^.
                              internal_address, new_binding_section_offset, status);
                        IF NOT status.normal THEN
                          RETURN;
                        IFEND;

                        build_new_adr_record (ocv$new_binding_section_ordinal,
                              ocv$last_new_binding_template^.binding_template.binding_offset,
                              ocv$last_new_binding_template^.binding_template.section_ordinal,
                              ocv$last_new_binding_template^.binding_template.offset,
                              ocv$last_new_binding_template^.binding_template.internal_address, 0, status);
                        IF NOT status.normal THEN
                          RETURN;
                        IFEND;
                      IFEND;

                    = llc$external_reference =
                      search_entry_point_sorted_list (old_binding_template_item^.binding_template^.name,
                            external_found, entry_point_address_item);

                      IF NOT external_found THEN

{ Check if this external has already been referenced and has an entry in the
{ the new binding template.

                        search_binding_temp_for_name (old_binding_template_item^.binding_template^.name,
                              old_binding_template_item^.binding_template^.address, new_template_item_found,
                              new_binding_section_offset);

                        IF NOT new_template_item_found THEN
                          build_external_template_entry (old_binding_template_item,
                                new_binding_section_offset, status);
                          IF NOT status.normal THEN
                            RETURN;
                          IFEND;

                          find_offset_operand (ocv$last_new_binding_template^.binding_template.name,
                                old_binding_template_offset, external_linkage, address_kind, offset_operand,
                                status);
                          IF NOT status.normal THEN
                            RETURN;
                          IFEND;

                          build_new_ext_record (external_linkage, ocv$new_binding_section_ordinal,
                                ocv$last_new_binding_template^.binding_template.binding_offset, address_kind,
                                offset_operand, status);
                          IF NOT status.normal THEN
                            RETURN;
                          IFEND;
                        IFEND;

                      ELSE
                        IF entry_point_address_item^.defined THEN
                          new_address_kind := old_binding_template_item^.binding_template^.address;
                          new_section_ordinal := entry_point_address_item^.section_ordinal;
                          new_section_offset := entry_point_address_item^.offset;
                          IF (old_binding_template_item^.binding_template^.address = llc$address_addition) OR
                                (old_binding_template_item^.binding_template^.address =
                                llc$address_subtraction) THEN
                            find_offset_operand (old_binding_template_item^.binding_template^.name,
                                  old_binding_template_offset, external_linkage, address_kind, offset_operand,
                                  status);
                            IF NOT status.normal THEN
                              RETURN;
                            IFEND;

                            new_address_kind := llc$address;
                            IF old_binding_template_item^.binding_template^.address =
                                  llc$address_addition THEN
                              new_section_offset := new_section_offset + offset_operand;
                            ELSE
                              new_section_offset := new_section_offset - offset_operand;
                            IFEND;
                          IFEND;
                        ELSE

{ Pointer stored in value address of the binding section points to another
{ binding section entry.

                          new_section_ordinal := ocv$new_binding_section_ordinal;
                          generate_binding_template_item (entry_point_address_item^.component^,
                                entry_point_address_item^.old_binding_offset, new_section_offset, status);
                          IF NOT status.normal THEN
                            RETURN;
                          IFEND;
                        IFEND;

{ Check if the new binding template already contains an entry with the corresponding
{ new_section ordinal and offset.

                        search_binding_temp_for_address (new_section_ordinal, new_section_offset,
                              new_address_kind, new_template_item_found, new_binding_section_offset);

                        IF NOT new_template_item_found THEN
                          build_current_template_entry (new_address_kind, new_binding_section_offset, status);
                          build_new_adr_record (ocv$new_binding_section_ordinal,
                                ocv$last_new_binding_template^.binding_template.binding_offset,
                                ocv$last_new_binding_template^.binding_template.section_ordinal,
                                ocv$last_new_binding_template^.binding_template.offset,
                                ocv$last_new_binding_template^.binding_template.internal_address, 0, status);
                          IF NOT status.normal THEN
                            RETURN;
                          IFEND;
                        IFEND;
                      IFEND;
                    CASEND;

                    old_binding_template_item^.new_binding_section_offset := new_binding_section_offset;
                    old_binding_template_item^.referenced_in_new_binding_sect := TRUE;
                  IFEND;
                PROCEND generate_binding_template_item;
?? OLDTITLE ??
?? NEWTITLE := '                BUILD_NEW_ENTRY_POINT_DEFN' ??
?? EJECT ??

                PROCEDURE build_new_entry_point_defn
                  (    separated_components: ^oct$separated_components;
                       starting_procedure: pmt$program_name;
                   VAR entry_point_address_list: oct$entry_point_address_list;
                       new_entry_definition_list: {output} ^oct$entry_definition_list;
                   VAR number_of_entry_definitions: llt$entry_point_index;
                       module_attributes: llt$module_attributes;
                   VAR status: ost$status);



                  CONST
                    c$allocation_size = 100;

                  TYPE
                    t$external = record
                      ext: ^oct$external_linkage_list,
                      module_name: ^pmt$program_name,
                      link: ^t$external,
                    recend,

                    t$external_list = record
                      name: ^pmt$program_name,
                      externals: ^t$external,
                      l_link: ^t$external_list,
                      r_link: ^t$external_list,
                    recend;


?? NEWTITLE := '                  BUILD_EXTERNAL_LIST' ??
?? EJECT ??

                  PROCEDURE build_external_list
                    (    separated_components: ^oct$separated_components;
                     VAR external_list: ^t$external_list;
                     VAR status: ost$status);


                    VAR
                      i: llt$module_index,
                      external: ^oct$external_linkage_list,
                      el_array: ^array [1 .. c$allocation_size] of t$external_list,
                      e_array: ^array [1 .. c$allocation_size] of t$external,
                      next_el: 1 .. c$allocation_size + 1,
                      next_e: 1 .. c$allocation_size + 1,
                      el: ^^t$external_list,
                      e: ^t$external;


                    external_list := NIL;
                    next_el := c$allocation_size + 1;
                    next_e := c$allocation_size + 1;

                    FOR i := 1 TO UPPERBOUND (separated_components^) DO
                      external := separated_components^ [i].external_linkage_list;

                      WHILE external <> NIL DO
                        el := ^external_list;

                      /loop/
                        WHILE el^ <> NIL DO
                          IF external^.external_linkage.name = el^^.name^ THEN
                            IF (external^.external_linkage.declaration_matching_required AND
                                  el^^.externals^.ext^.external_linkage.declaration_matching_required) AND
                                  (external^.external_linkage.language =
                                  el^^.externals^.ext^.external_linkage.language) THEN
                              IF (external^.external_linkage.language = llc$cybil) THEN
                                IF (external^.external_linkage.declaration_matching.object_encryption <>
                                      el^^.externals^.ext^.external_linkage.declaration_matching.
                                      object_encryption) THEN
                                  osp$set_status_abnormal (oc, oce$w_decl_mismatch_ext_object, el^^.name^,
                                       status);
                                 osp$append_status_parameter (osc$status_parameter_delimiter,
                                       el^^.externals^.module_name^, status);
                                 osp$append_status_parameter (osc$status_parameter_delimiter,
                                       separated_components^ [i].header^.name, status);
                                 ocp$generate_message (status);
                                 osp$set_status_abnormal (oc, oce$w_non_fatal_generate_error, '',
                                       command_status);
                               ELSEIF (external^.external_linkage.declaration_matching.source_encryption <>
                                     el^^.externals^.ext^.external_linkage.declaration_matching.
                                     source_encryption) THEN
                                 osp$set_status_abnormal (oc, oce$w_decl_mismatch_ext_source, el^^.name^,
                                       status);
                                 osp$append_status_parameter (osc$status_parameter_delimiter,
                                       el^^.externals^.module_name^, status);
                                 osp$append_status_parameter (osc$status_parameter_delimiter,
                                       separated_components^ [i].header^.name, status);
                                 ocp$generate_message (status);
                                 osp$set_status_abnormal (oc, oce$w_non_fatal_generate_error, '',
                                       command_status);
                               IFEND;
                             ELSE
                               IF (external^.external_linkage.declaration_matching.language_dependent_value <>
                                     el^^.externals^.ext^.external_linkage.declaration_matching.
                                     language_dependent_value) THEN
                                 osp$set_status_abnormal (oc, oce$w_decl_mismatch_ext_source, el^^.name^,
                                       status);
                                 osp$append_status_parameter (osc$status_parameter_delimiter,
                                       el^^.externals^.module_name^, status);
                                 osp$append_status_parameter (osc$status_parameter_delimiter,
                                       separated_components^ [i].header^.name, status);
                                 ocp$generate_message (status);
                                 osp$set_status_abnormal (oc, oce$w_non_fatal_generate_error, '',
                                       command_status);
                               IFEND;
                             IFEND;
                           IFEND;
                           IF next_e > c$allocation_size THEN
                             NEXT e_array IN segment_3;
                             IF e_array = NIL THEN
                               osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                               RETURN;
                             IFEND;
                             next_e := 1;
                           IFEND;

                           e := ^e_array^ [next_e];
                           next_e := next_e + 1;
                           e^.ext := external;
                           e^.module_name := ^separated_components^ [i].header^.name;
                           e^.link := el^^.externals;
                           el^^.externals := e;
                           EXIT /loop/;
                         ELSEIF external^.external_linkage.name > el^^.name^ THEN
                           el := ^el^^.r_link;
                         ELSE
                           el := ^el^^.l_link;
                         IFEND;
                       WHILEND /loop/;

                       IF el^ = NIL THEN
                         IF next_el > c$allocation_size THEN
                           NEXT el_array IN segment_3;
                           IF el_array = NIL THEN
                             osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                             RETURN;
                           IFEND;
                           next_el := 1;
                         IFEND;

                         el^ := ^el_array^ [next_el];
                         next_el := next_el + 1;
                         el^^.name := ^external^.external_linkage.name;

                         IF next_e > c$allocation_size THEN
                           NEXT e_array IN segment_3;
                           IF e_array = NIL THEN
                             osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                             RETURN;
                           IFEND;
                           next_e := 1;
                         IFEND;

                         el^^.externals := ^e_array^ [next_e];
                         next_e := next_e + 1;
                         el^^.externals^.ext := external;
                         el^^.externals^.module_name := ^separated_components^ [i].header^.name;
                         el^^.externals^.link := NIL;

                         el^^.l_link := NIL;
                         el^^.r_link := NIL;
                       IFEND;

                       external := external^.link;
                     WHILEND;
                   FOREND;


                 PROCEND build_external_list;
?? OLDTITLE ??
?? NEWTITLE := '                  SEARCH_EXTERNAL_LIST' ??
?? EJECT ??

                 PROCEDURE search_external_list
                   (    entry: ^oct$entry_definition_list;
                        module_name: ^pmt$program_name;
                        external_list: ^t$external_list;
                        module_attributes: llt$module_attributes;
                    VAR referenced_in_new_module: boolean);


                   VAR
                     apl: ^oct$actual_parameter_list,
                     el: ^t$external_list,
                     e: ^t$external;

                   el := external_list;

                   WHILE el <> NIL DO
                     IF el^.name^ = entry^.changed_name^ THEN
                       e := el^.externals;
                       WHILE e <> NIL DO
                         IF entry^.formal_parameter <> NIL THEN
                           apl := e^.ext^.actual_parameter_list.nnext;
                           WHILE apl <> NIL DO
                             fortran_argument_checking (apl^.actual_parameter, entry^.formal_parameter,
                                   module_name^, e^.module_name^);
                             apl := apl^.nnext;
                           WHILEND;
                         IFEND;
                         IF (entry^.entry_definition.declaration_matching_required AND
                               e^.ext^.external_linkage.declaration_matching_required) AND
                               (entry^.entry_definition.language = e^.ext^.external_linkage.language) THEN
                           IF (entry^.entry_definition.language = llc$cybil) THEN
                             IF (llc$object_cybil_checking IN module_attributes) THEN
                               IF (entry^.entry_definition.declaration_matching.object_encryption <>
                                     e^.ext^.external_linkage.declaration_matching.object_encryption) THEN
                                 osp$set_status_abnormal (oc, oce$f_declaration_mismatch,
                                       entry^.changed_name^, status);
                                 osp$append_status_parameter (osc$status_parameter_delimiter, module_name^,
                                       status);
                                 osp$append_status_parameter (osc$status_parameter_delimiter, e^.module_name^,
                                       status);
                                 ocp$generate_message (status);
                                 osp$set_status_abnormal (oc, oce$e_fatal_error, '', command_status);
                               IFEND;
                             ELSE { source type checking
                               IF (entry^.entry_definition.declaration_matching.source_encryption <>
                                     e^.ext^.external_linkage.declaration_matching.source_encryption) THEN
                                 osp$set_status_abnormal (oc, oce$w_declaration_mismatch,
                                       entry^.changed_name^, status);
                                 osp$append_status_parameter (osc$status_parameter_delimiter, module_name^,
                                       status);
                                 osp$append_status_parameter (osc$status_parameter_delimiter, e^.module_name^,
                                       status);
                                 ocp$generate_message (status);
                                 osp$set_status_abnormal (oc, oce$w_non_fatal_generate_error, '',
                                       command_status);
                               IFEND;
                             IFEND;
                           ELSE { language is not CYBIL
                             IF (entry^.entry_definition.declaration_matching.language_dependent_value <>
                                   e^.ext^.external_linkage.declaration_matching.language_dependent_value)
                                   THEN
                               osp$set_status_abnormal (oc, oce$w_declaration_mismatch, entry^.changed_name^,
                                     status);
                               osp$append_status_parameter (osc$status_parameter_delimiter, module_name^,
                                     status);
                               osp$append_status_parameter (osc$status_parameter_delimiter, e^.module_name^,
                                     status);
                               ocp$generate_message (status);
                               osp$set_status_abnormal (oc, oce$w_non_fatal_generate_error, '',
                                     command_status);
                             IFEND;
                           IFEND;
                         IFEND;
                         e := e^.link;
                       WHILEND;

                       referenced_in_new_module := TRUE;
                       RETURN;
                     ELSEIF entry^.changed_name^ > el^.name^ THEN
                       el := el^.r_link;
                     ELSE
                       el := el^.l_link;
                     IFEND;
                   WHILEND;

                   referenced_in_new_module := FALSE;


                 PROCEND search_external_list;
?? OLDTITLE ??
?? EJECT ??

                 VAR
                   i: llt$module_index,
                   entry_point: ^oct$entry_definition_list,
                   entry_definition: llt$entry_definition,
                   entry_point_address_item: ^oct$entry_point_address_list,
                   number_of_entry_points: llt$entry_point_index,
                   last_new_entry_definition: ^oct$entry_definition_list,
                   external_list: ^t$external_list,
                   formal_parameter: ^llt$formal_parameters,
                   referenced_in_new_module: boolean,
                   segment_offset: ost$segment_offset;

{ generate the entry point address list

                 number_of_entry_points := 0;
                 entry_point_address_item := ^entry_point_address_list;

                 FOR i := 1 TO UPPERBOUND (separated_components^) DO
                   entry_point := separated_components^ [i].entry_definition_list.link;

                   WHILE entry_point <> NIL DO
                     entry_definition := entry_point^.entry_definition;

                     NEXT entry_point_address_item^.link IN segment_4;
                     entry_point_address_item := entry_point_address_item^.link;
                     IF entry_point_address_item = NIL THEN
                       osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
                       RETURN;
                     IFEND;

                     number_of_entry_points := number_of_entry_points + 1;
                     entry_point_address_item^.name := entry_definition.name;

                     IF separated_components^ [i].section_definitions^ [entry_definition.section_ordinal]^.
                           section_definition.kind = llc$binding_section THEN
                       entry_point_address_item^.defined := FALSE;
                       entry_point_address_item^.component := ^separated_components^ [i];
                       entry_point_address_item^.old_binding_offset := entry_definition.offset;
                     ELSE
                       entry_point_address_item^.defined := TRUE;
                       relocated_section_ordinal (separated_components^ [i], entry_definition.section_ordinal,
                             entry_point_address_item^.section_ordinal);
                       entry_point_address_item^.offset := relocated_section_offset
                             (separated_components^ [i], entry_definition.section_ordinal,
                             entry_definition.offset);
                     IFEND;

                     entry_point := entry_point^.link;
                   WHILEND;
                 FOREND;

                 entry_point_address_item^.link := NIL;

                 build_entry_point_sorted_list (number_of_entry_points, entry_point_address_list.link,
                       entry_point_sorted_list, status);
                 IF NOT status.normal THEN
                   RETURN;
                 IFEND;

{ generate new entry definition records


                 build_external_list (separated_components, external_list, status);
                 IF NOT status.normal THEN
                   RETURN;
                 IFEND;

                 entry_point_address_item := entry_point_address_list.link;
                 last_new_entry_definition := new_entry_definition_list;

                 FOR i := 1 TO UPPERBOUND (separated_components^) DO
                   entry_point := separated_components^ [i].entry_definition_list.link;

                   WHILE entry_point <> NIL DO
                     entry_definition := entry_point^.entry_definition;
                     search_external_list (entry_point, ^separated_components^ [i].header^.name,
                           external_list, module_attributes, referenced_in_new_module);

                     IF ((entry_definition.attributes <> $llt$entry_point_attributes []) OR
                           (NOT referenced_in_new_module) OR (entry_definition.name = starting_procedure)) AND
                           (entry_point^.changed_name^ <> osc$null_name) THEN

                       IF separated_components^ [i].section_definitions^ [entry_definition.section_ordinal]^.
                             section_definition.kind = llc$binding_section THEN

                         entry_point_address_item^.defined := TRUE;
                         generate_binding_template_item (separated_components^ [i], entry_definition.offset,
                               segment_offset, status);
                         IF NOT status.normal THEN
                           RETURN;
                         IFEND;
                         entry_point_address_item^.offset := segment_offset;

                         entry_point_address_item^.section_ordinal := ocv$new_binding_section_ordinal;
                       IFEND;

                       last_new_entry_definition^.link := entry_point;
                       last_new_entry_definition := last_new_entry_definition^.link;
                       last_new_entry_definition^.entry_definition.section_ordinal :=
                             entry_point_address_item^.section_ordinal;
                       last_new_entry_definition^.entry_definition.offset := entry_point_address_item^.offset;
                       last_new_entry_definition^.entry_definition.name := entry_point^.changed_name^;

                       number_of_entry_definitions := number_of_entry_definitions + 1;

                       IF entry_definition.name = starting_procedure THEN
                         last_new_entry_definition^.entry_definition.attributes :=
                               last_new_entry_definition^.entry_definition.attributes +
                               $llt$entry_point_attributes [llc$retain_entry_point];
                         IF separated_components^ [i].section_definitions^
                               [entry_definition.section_ordinal]^.section_definition.kind <>
                               llc$code_section THEN
                           osp$set_status_abnormal (oc, oce$e_starting_proc_not_in_code, starting_procedure,
                                 status);
                           RETURN;
                         IFEND;
                       IFEND;
                     IFEND;

                     entry_point := entry_point^.link;
                     entry_point_address_item := entry_point_address_item^.link;
                   WHILEND;

                 FOREND;

                 last_new_entry_definition^.link := NIL;

               PROCEND build_new_entry_point_defn;


?? OLDTITLE ??
?? NEWTITLE := '                FORTRAN_ARGUMENT_CHECKING' ??
?? EJECT ??

               PROCEDURE fortran_argument_checking
                 (VAR actual_parameters: ^llt$actual_parameters;
                      formal_parameters: ^llt$formal_parameters;
                      mod1: pmt$program_name;
                      mod2: pmt$program_name);

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

?? FMT (FORMAT := OFF) ??


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



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


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

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

  ?? FMT (FORMAT := ON) ??

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

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

                 NEXT actual_parameter_descriptor IN actual_seq;
                 NEXT formal_parameter_descriptor IN formal_seq;

                 parameter_number := 0;
                 WHILE (actual_parameter_descriptor <> NIL) AND (formal_parameter_descriptor <> NIL) DO
                   type_valid := fortran_argument_type_checking [actual_parameter_descriptor^.argument_type]
                         [formal_parameter_descriptor^.argument_type];
                   IF NOT type_valid THEN
                     osp$set_status_abnormal (oc, oce$invalid_type_matching, mod2, status);
                     osp$append_status_parameter (osc$status_parameter_delimiter, mod1, status);
                     osp$append_status_integer (osc$status_parameter_delimiter, parameter_number, 10, FALSE,
                           status);
                     osp$append_status_parameter (osc$status_parameter_delimiter,
                           actual_parameters^.callee_name, status);
                     ocp$generate_message (status);
                   ELSE
                     kind_valid := fortran_argument_kind_checking
                           [actual_parameter_descriptor^.argument_kind]
                           [formal_parameter_descriptor^.argument_kind];
                     IF NOT kind_valid THEN
                       osp$set_status_abnormal (oc, oce$invalid_kind_matching, mod2, status);
                       osp$append_status_parameter (osc$status_parameter_delimiter, mod1, status);
                       osp$append_status_integer (osc$status_parameter_delimiter, parameter_number, 10, FALSE,
                             status);
                       osp$append_status_parameter (osc$status_parameter_delimiter,
                             actual_parameters^.callee_name, status);
                       ocp$generate_message (status);
                     ELSE
                       usage_valid := fortran_argument_usage_checking [actual_parameter_descriptor^.mode]
                             [formal_parameter_descriptor^.mode];
                       IF NOT usage_valid THEN
                         osp$set_status_abnormal (oc, oce$invalid_mode_matching, mod2, status);
                         osp$append_status_parameter (osc$status_parameter_delimiter, mod1, status);
                         osp$append_status_integer (osc$status_parameter_delimiter, parameter_number, 10,
                               FALSE, status);
                         osp$append_status_parameter (osc$status_parameter_delimiter,
                               actual_parameters^.callee_name, status);
                         ocp$generate_message (status);
                       IFEND;
                     IFEND;
                   IFEND;

                   IF (actual_parameter_descriptor^.argument_type = llc$fortran_char) AND
                         (formal_parameter_descriptor^.argument_type = llc$fortran_boolean) THEN
                     valid := actual_parameter_descriptor^.string_length.number_of_characters >= 8;
                     IF NOT valid THEN
                       osp$set_status_abnormal (oc, oce$bad_char_length, mod1, status);
                       osp$append_status_integer (c$spd, parameter_number, 10, FALSE, status);
                       osp$append_status_integer (c$spd, actual_parameter_descriptor^.string_length.
                             number_of_characters, 10, FALSE, status);
                       osp$append_status_integer (c$spd, formal_parameter_descriptor^.string_length.
                             number_of_characters, 10, FALSE, status);
                       ocp$generate_message (status);
                     IFEND;
                   IFEND;

                   IF (actual_parameter_descriptor^.argument_type = llc$fortran_char) AND
                         (formal_parameter_descriptor^.argument_type = llc$fortran_char) AND
                         (NOT (llc$fortran_assumed_len_string IN actual_parameter_descriptor^.string_length.
                         attributes)) THEN
                     valid := actual_parameter_descriptor^.string_length.number_of_characters >=
                           formal_parameter_descriptor^.string_length.number_of_characters;
                     IF NOT valid THEN
                       osp$set_status_abnormal (oc, oce$bad_char_length, mod1, status);
                       osp$append_status_integer (c$spd, parameter_number, 10, FALSE, status);
                       osp$append_status_integer (c$spd, actual_parameter_descriptor^.string_length.
                             number_of_characters, 10, FALSE, status);
                       osp$append_status_integer (c$spd, formal_parameter_descriptor^.string_length.
                             number_of_characters, 10, FALSE, status);
                       ocp$generate_message (status);
                     IFEND;
                   IFEND;

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

                       IF formal_parameter_descriptor^.argument_kind = llc$fortran_array THEN
                         formal_length := formal_parameter_descriptor^.array_size.number_of_elements *
                               formal_parameter_descriptor^.string_length.number_of_characters;
                       ELSE
                         formal_length := formal_parameter_descriptor^.string_length.number_of_characters;
                       IFEND;
                       valid := actual_length >= formal_length;
                       IF NOT valid THEN
                         osp$set_status_abnormal (oc, oce$actual_less_than_formal, mod1, status);
                         osp$append_status_integer (c$spd, parameter_number, 10, FALSE, status);
                         osp$append_status_integer (c$spd, actual_length, 10, FALSE, status);
                         osp$append_status_integer (c$spd, formal_length, 10, FALSE, status);
                         ocp$generate_message (status);
                       IFEND;
                     IFEND;
                   IFEND;

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

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

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

{ End of code to maintain compatibility

                     valid := actual_length = formal_length;
                     IF NOT valid THEN
                       osp$set_status_abnormal (oc, oce$bad_integer_length, mod2, status);
                       osp$append_status_parameter (osc$status_parameter_delimiter, mod1, status);
                       osp$append_status_integer (osc$status_parameter_delimiter, parameter_number, 10, FALSE,
                             status);
                       osp$append_status_parameter (osc$status_parameter_delimiter,
                             actual_parameters^.callee_name, status);
                       ocp$generate_message (status);
                     IFEND;
                   IFEND;

                   IF formal_parameter_descriptor^.argument_kind = llc$fortran_array THEN
                     IF llc$fortran_assumed_shape_array IN formal_parameter_descriptor^.array_size.
                           attributes THEN
                       IF ((actual_parameter_descriptor^.argument_kind <> llc$fortran_array) OR
                             (llc$fortran_assumed_len_array IN actual_parameter_descriptor^.array_size.
                             attributes) OR (formal_parameter_descriptor^.array_size.rank <>
                             actual_parameter_descriptor^.array_size.rank)) THEN
                         osp$set_status_abnormal (oc, oce$fortran_array_type_mismatch, mod2, status);
                         osp$append_status_parameter (c$spd, mod1, status);
                         osp$append_status_integer (c$spd, parameter_number, 10, FALSE, status);
                         ocp$generate_message (status);
                       IFEND;
                     ELSE
                       IF (actual_parameter_descriptor^.argument_kind = llc$fortran_array) AND
                             ((llc$fortran_assumed_shape_array IN actual_parameter_descriptor^.array_size.
                             attributes) OR (llc$fortran_array_section IN
                             actual_parameter_descriptor^.array_size.attributes)) THEN
                         osp$set_status_abnormal (oc, oce$fortran_array_type_mismatch, mod2, status);
                         osp$append_status_parameter (c$spd, mod1, status);
                         osp$append_status_integer (c$spd, parameter_number, 10, FALSE, status);
                         ocp$generate_message (status);
                       IFEND;
                     IFEND;
                   IFEND;

                   NEXT actual_parameter_descriptor IN actual_seq;
                   NEXT formal_parameter_descriptor IN formal_seq;
                   parameter_number := parameter_number + 1;
                 WHILEND;
                 IF (actual_parameter_descriptor = NIL) AND (formal_parameter_descriptor <> NIL) THEN
                   osp$set_status_abnormal (oc, oce$invalid_param_for_proc, actual_parameters^.callee_name,
                         status);
                   osp$append_status_parameter (osc$status_parameter_delimiter, mod2, status);
                   osp$append_status_parameter (osc$status_parameter_delimiter, mod1, status);
                   ocp$generate_message (status);
                 IFEND;
               PROCEND fortran_argument_checking;


?? OLDTITLE ??
?? NEWTITLE := '                PROCESS_RELOCATION_RECORDS' ??
?? EJECT ??

               PROCEDURE process_relocation_records
                 (    separated_components: ^oct$separated_components;
                  VAR new_relocation_list: oct$relocation_list;
                  VAR status: ost$status);

?? NEWTITLE := '                  FETCH_OLD_RELOCATION_VALUE' ??
?? EJECT ??

                 PROCEDURE fetch_old_relocation_value
                   (    component: oct$separated_module_header;
                        old_relocation: llt$relocation_item;
                    VAR old_relocation_value: llt$section_offset;
                    VAR new_relocation: llt$relocation_item;
                    VAR container_location: ^cell;
                    VAR instruction_location: ^cell;
                    VAR temp_bit_string: bit_string_array;
                    VAR bit_string_insertion_record: ^llt$bit_string_insertion;
                    VAR status: ost$status);



                   VAR
                     parcel_container: ^packed record
                       case 0 .. 1 of

                       = 0 =
                         parcel: 0 .. 0ffff(16),

                       = 1 =
                         sign_bit: boolean,
                       casend,
                     recend,

                     three_byte_container: ^packed record
                       case 0 .. 1 of

                       = 0 =
                         three_byte: 0 .. 0ffffff(16),

                       = 1 =
                         sign_bit: boolean,
                       casend,
                     recend,

                     halfword_container: ^packed record
                       case 0 .. 1 of

                       = 0 =
                         halfword: 0 .. 0ffffffff(16),

                       = 1 =
                         sign_bit: boolean,
                       casend,
                     recend,

                     word_container: ^packed record
                       case 0 .. 1 of

                       = 0 =
                         word: integer,

                       = 1 =
                         sign_bit: boolean,
                       casend,
                     recend,

                     d_field_container: ^packed record
                       case 0 .. 1 of

                       = 0 =
                         i_portion: 0 .. 0f(16),
                         d_portion: 0 .. 0fff(16),

                       = 1 =
                         filler: 0 .. 0f(16),
                         sign_bit: boolean,
                       casend,
                     recend,

                     q_field_container: ^packed record
                       case 0 .. 1 of

                       = 0 =
                         q_field: oct$q_field,

                       = 1 =
                         sign_bit: boolean,
                       casend,
                     recend,

                     long_d_field_container: ^packed record
                       case 0 .. 1 of

                       = 0 =
                         long_d_field: 0 .. 0ffffff(16),

                       = 1 =
                         sign_bit: boolean,
                       casend,
                     recend,

                     bit_offset: 0 .. 7,
                     bit: 1 .. 63,

                     container_offset: llt$section_offset,
                     container_size: [STATIC] array [llt$relocation_container] of 2 .. 8 :=
                           [2, 3, 4, 8, 2, 2, 3],
                     section_length: ost$segment_length,

                     offset: llt$section_offset,
                     length: integer,
                     number_of_replications: integer,

                     sign_bit_on: boolean,

                     text_insertion: ^oct$text_insertion_list;


                   instruction_location := NIL;

                   relocated_section_ordinal (component, old_relocation.section_ordinal,
                         new_relocation.section_ordinal);
                   new_relocation.offset := relocated_section_offset
                         (component, old_relocation.section_ordinal, old_relocation.offset);

                 /get_container_location/
                   BEGIN
                     IF component.section_definitions^ [old_relocation.section_ordinal]^.new^.section_ptr <>
                           NIL THEN

                       section_length := #SIZE (component.section_definitions^
                             [old_relocation.section_ordinal]^.new^.section_ptr^);
                       IF (new_relocation.offset + container_size [old_relocation.container]) >
                             section_length THEN
                         osp$set_status_abnormal (oc, oce$e_container_outside_record, component.header^.name,
                               status);
                         RETURN;
                       IFEND;

                       container_location := #LOC (component.section_definitions^
                             [old_relocation.section_ordinal]^.new^.section_ptr^ [new_relocation.offset]);

                       IF (new_relocation.offset - 2) >= 0 THEN
                         IF old_relocation.container = llc$180_q_field THEN
                           instruction_location := #LOC (component.section_definitions^
                                 [old_relocation.section_ordinal]^.new^.
                                 section_ptr^ [new_relocation.offset - 2]);
                         IFEND;
                       ELSE
                         osp$set_status_abnormal (oc, oce$e_opcode_not_within_record, component.header^.name,
                               status);
                         RETURN;
                       IFEND;

                       EXIT /get_container_location/;

                     ELSE
                       container_location := NIL;

                       text_insertion := component.section_definitions^ [old_relocation.section_ordinal]^.
                             new^.text_insertion_records.link;

                       WHILE (text_insertion <> NIL) AND (NOT text_insertion^.overlapped) AND
                             ((text_insertion^.offset + text_insertion^.length) >= new_relocation.offset) DO

                         CASE text_insertion^.kind OF

                         = llc$text =
                           length := text_insertion^.length;
                           IF (new_relocation.offset >= text_insertion^.offset) AND
                                 (new_relocation.offset < (text_insertion^.offset + length)) THEN

                             IF (new_relocation.offset + container_size [old_relocation.container]) >
                                   (text_insertion^.offset + length) THEN
                               osp$set_status_abnormal (oc, oce$e_container_outside_record,
                                     component.header^.name, status);
                               RETURN;
                             IFEND;


                             container_offset := new_relocation.offset - text_insertion^.text^.offset;
                             container_location := #LOC (text_insertion^.text^.byte [container_offset + 1]);

                             IF (container_offset - 2) >= 0 THEN
                               IF old_relocation.container = llc$180_q_field THEN
                                 instruction_location := #LOC (text_insertion^.text^.
                                       byte [(container_offset - 2) + 1])
                               IFEND;
                             ELSE
                               osp$set_status_abnormal (oc, oce$e_opcode_not_within_record,
                                     component.header^.name, status);
                               RETURN;
                             IFEND;

                             EXIT /get_container_location/;
                           IFEND;

                         = llc$replication =
                           IF new_relocation.offset >= text_insertion^.offset THEN
                             offset := text_insertion^.offset;
                             length := #SIZE (text_insertion^.replication^.byte);

                           /check_replications_for_offset/
                             FOR number_of_replications := 1 TO text_insertion^.replication^.count DO
                               IF (new_relocation.offset >= offset) THEN
                                 IF new_relocation.offset < (offset + length) THEN
                                   IF (new_relocation.offset + container_size [old_relocation.container]) >
                                       (offset + length) THEN
                                   osp$set_status_abnormal (oc, oce$e_container_outside_record,
                                       component.header^.name, status);
                                 RETURN;
                               IFEND;
                               container_offset := new_relocation.offset - offset;
                               container_location := #LOC (text_insertion^.replication^.
                                     byte [container_offset + 1]);

                               IF (container_offset - 2) >= 0 THEN
                                 IF old_relocation.container = llc$180_q_field THEN
                                   instruction_location := #LOC (text_insertion^.replication^.
                                       byte [(container_offset - 2) + 1]);
                               IFEND;
                             ELSE
                               osp$set_status_abnormal (oc, oce$e_opcode_not_within_record,
                                     component.header^.name, status);
                               RETURN;
                             IFEND;

                             EXIT /get_container_location/;
                           IFEND;
                         ELSE
                           EXIT /check_replications_for_offset/;
                         IFEND;

                         offset := offset + text_insertion^.replication^.increment;
                       FOREND /check_replications_for_offset/;
                     IFEND;

                   = llc$bit_string_insertion =
                     bit_string_insertion_record := text_insertion^.bit_string_insertion;

                     length := ((bit_string_insertion_record^.bit_offset +
                           bit_string_insertion_record^.bit_length + 7) DIV 8);
                     IF (new_relocation.offset >= bit_string_insertion_record^.offset) AND
                           (new_relocation.offset < bit_string_insertion_record^.offset + length) THEN

                       container_offset := new_relocation.offset - bit_string_insertion_record^.offset;

                       IF ((container_offset = 0) AND (bit_string_insertion_record^.bit_offset <> 0) AND
                             ((bit_string_insertion_record^.bit_offset <> 4) OR
                             (new_relocation.container <> llc$180_d_field))) OR
                             (((container_offset + container_size [old_relocation.container]) * 8) >
                             (bit_string_insertion_record^.bit_offset +
                             bit_string_insertion_record^.bit_length)) THEN
                         osp$set_status_abnormal (oc, oce$e_container_outside_record, component.header^.name,
                               status);
                         RETURN;
                       IFEND;

                       bit_offset := text_insertion^.bit_string_insertion^.bit_offset;
                       FOR bit := 1 TO text_insertion^.bit_string_insertion^.bit_length DO
                         temp_bit_string.bit_array [bit + bit_offset] :=
                               text_insertion^.bit_string_insertion^.bit_string [bit];
                       FOREND;

                       container_location := #LOC (temp_bit_string.byte_array [container_offset + 1]);

                       IF old_relocation.container = llc$180_q_field THEN
                         instruction_location := #LOC (temp_bit_string.byte_array [(container_offset - 2) +
                               1])
                       IFEND;
                       EXIT /get_container_location/;
                     IFEND;

                   CASEND;

                   text_insertion := text_insertion^.link;
                 WHILEND;

                 IF container_location = NIL THEN
                   osp$set_status_abnormal (oc, oce$relocation_value_not_found, component.header^.name,
                         status);
                   RETURN;
                 IFEND;
               IFEND;
             END /get_container_location/;

             CASE old_relocation.container OF

             = llc$two_bytes =
               parcel_container := container_location;
               old_relocation_value := parcel_container^.parcel;
               sign_bit_on := parcel_container^.sign_bit;

             = llc$three_bytes =
               three_byte_container := container_location;
               old_relocation_value := three_byte_container^.three_byte;
               sign_bit_on := three_byte_container^.sign_bit;

             = llc$four_bytes =
               halfword_container := container_location;
               old_relocation_value := halfword_container^.halfword;
               sign_bit_on := halfword_container^.sign_bit;

             = llc$eight_bytes =
               word_container := container_location;
               old_relocation_value := word_container^.word;
               sign_bit_on := word_container^.sign_bit;

             = llc$180_d_field =
               d_field_container := container_location;
               old_relocation_value := d_field_container^.d_portion;
               sign_bit_on := d_field_container^.sign_bit;

             = llc$180_q_field =
               q_field_container := container_location;
               old_relocation_value := q_field_container^.q_field.q;
               sign_bit_on := q_field_container^.sign_bit;

             = llc$180_long_d_field =
               long_d_field_container := container_location;
               old_relocation_value := long_d_field_container^.long_d_field;
               sign_bit_on := long_d_field_container^.sign_bit;
             ELSE
               osp$set_status_abnormal (oc, oce$e_invalid_container_kind, component.header^.name, status);
               RETURN;

             CASEND;

             CASE old_relocation.address OF

             = llc$byte_positive =

             = llc$two_byte_positive =
               old_relocation_value := old_relocation_value * 2;

             = llc$four_byte_positive =
               old_relocation_value := old_relocation_value * 4;

             = llc$eight_byte_positive =
               old_relocation_value := old_relocation_value * 8;

             = llc$byte_signed =
               IF sign_bit_on THEN
                 osp$set_status_abnormal (oc, oce$e_sign_bit_set_in_container, component.header^.name,
                       status);
                 RETURN;
               IFEND;

             = llc$two_byte_signed =
               old_relocation_value := old_relocation_value * 2;

               IF sign_bit_on THEN
                 osp$set_status_abnormal (oc, oce$e_sign_bit_set_in_container, component.header^.name,
                       status);
                 RETURN;
               IFEND;

             = llc$four_byte_signed =
               old_relocation_value := old_relocation_value * 4;

               IF sign_bit_on THEN
                 osp$set_status_abnormal (oc, oce$e_sign_bit_set_in_container, component.header^.name,
                       status);
                 RETURN;
               IFEND;

             = llc$eight_byte_signed =
               old_relocation_value := old_relocation_value * 8;

               IF sign_bit_on THEN
                 osp$set_status_abnormal (oc, oce$e_sign_bit_set_in_container, component.header^.name,
                       status);
                 RETURN;
               IFEND;

             ELSE
               osp$set_status_abnormal (oc, oce$e_invalid_container_adr_typ, component.header^.name, status);
             CASEND;

           PROCEND fetch_old_relocation_value;
?? OLDTITLE ??
?? NEWTITLE := '                  BUILD_CALLREL_USING_A3' ??
?? EJECT ??

           PROCEDURE build_callrel_using_a3
             (    instruction_location: ^cell;
                  relocation_distance: integer;
              VAR status: ost$status);


             VAR
               instruction: ^packed record
                 opcode: 0(16) .. 0ff(16),
                 j_field: 0(16) .. 0f(16),
                 k_field: 0(16) .. 0f(16),
                 q_field: oct$q_field,
               recend;


             instruction := instruction_location;

             instruction^.opcode := 0b0(16);
             instruction^.j_field := 3;

             IF (relocation_distance < LOWERVALUE (instruction^.q_field.q)) OR
                   (relocation_distance > UPPERVALUE (instruction^.q_field.q)) THEN
               osp$set_status_abnormal (oc, oce$container_overflow, 'Q-field in a CALLREL instruction',
                     status);
               RETURN;
             IFEND;

             instruction^.q_field.q := relocation_distance;


           PROCEND build_callrel_using_a3;
?? OLDTITLE ??
?? NEWTITLE := '                  BUILD_CALLREL_USING_AJ' ??
?? EJECT ??

           PROCEDURE build_callrel_using_aj
             (    instruction_location: ^cell;
                  relocation_distance: integer;
              VAR status: ost$status);


             VAR
               instruction: ^packed record
                 opcode: 0(16) .. 0ff(16),
                 j_field: 0(16) .. 0f(16),
                 k_field: 0(16) .. 0f(16),
                 q_field: oct$q_field,
               recend;


             instruction := instruction_location;

             instruction^.opcode := 0b0(16);

             IF (relocation_distance < LOWERVALUE (instruction^.q_field.q)) OR
                   (relocation_distance > UPPERVALUE (instruction^.q_field.q)) THEN
               osp$set_status_abnormal (oc, oce$container_overflow, 'Q-field in a CALLREL instruction',
                     status);
               RETURN;
             IFEND;

             instruction^.q_field.q := relocation_distance;


           PROCEND build_callrel_using_aj;
?? OLDTITLE ??
?? NEWTITLE := '                  REPLACE_NEW_RELOCATION_VALUE' ??
?? EJECT ??

           PROCEDURE replace_new_relocation_value
             (    new_relocation: llt$relocation_item;
                  temp_bit_string: bit_string_array;
                  module_name: pmt$program_name;
              VAR new_relocation_value: ost$segment_offset;
              VAR bit_string_insertion_record: ^llt$bit_string_insertion;
              VAR container_location: ^cell;
              VAR status: ost$status);


             VAR
               parcel_container: ^0(16) .. 0ffff(16),
               three_byte_container: ^0(16) .. 0ffffff(16),
               halfword_container: ^0(16) .. 0ffffffff(16),
               word_container: ^integer,
               d_field_container: ^packed record
                 i_portion: 0(16) .. 0f(16),
                 d_portion: 0(16) .. 0fff(16),
               recend,
               q_field_container: ^oct$q_field,
               long_d_field_container: ^0(16) .. 0ffffff(16),

               bit: 1 .. 63,

               container_offset: llt$section_offset,

               text_insertion: ^oct$text_insertion_list;


             CASE new_relocation.address OF

             = llc$byte_positive =

             = llc$two_byte_positive =
               new_relocation_value := new_relocation_value DIV 2;

             = llc$four_byte_positive =
               new_relocation_value := new_relocation_value DIV 4;

             = llc$eight_byte_positive =
               new_relocation_value := new_relocation_value DIV 8;

             = llc$byte_signed =

             = llc$two_byte_signed =
               new_relocation_value := new_relocation_value DIV 2;

             = llc$four_byte_signed =
               new_relocation_value := new_relocation_value DIV 4;

             = llc$eight_byte_signed =
               new_relocation_value := new_relocation_value DIV 8;

             CASEND;

             CASE new_relocation.container OF

             = llc$two_bytes =
               parcel_container := container_location;

               IF (new_relocation_value < LOWERVALUE (parcel_container^)) OR
                     (new_relocation_value > UPPERVALUE (parcel_container^)) THEN
                 osp$set_status_abnormal (oc, oce$container_overflow, 'parcel', status);
                 RETURN;
               IFEND;

               parcel_container^ := new_relocation_value;

             = llc$three_bytes =
               three_byte_container := container_location;

               IF (new_relocation_value < LOWERVALUE (three_byte_container^)) OR
                     (new_relocation_value > UPPERVALUE (three_byte_container^)) THEN
                 osp$set_status_abnormal (oc, oce$container_overflow, 'three bytes', status);
                 RETURN;
               IFEND;

               three_byte_container^ := new_relocation_value;

             = llc$four_bytes =
               halfword_container := container_location;

               IF (new_relocation_value < LOWERVALUE (halfword_container^)) OR
                     (new_relocation_value > UPPERVALUE (halfword_container^)) THEN
                 osp$set_status_abnormal (oc, oce$container_overflow, 'halfword', status);
                 RETURN;
               IFEND;

               halfword_container^ := new_relocation_value;

             = llc$eight_bytes =
               word_container := container_location;

               IF (new_relocation_value < LOWERVALUE (word_container^)) OR
                     (new_relocation_value > UPPERVALUE (word_container^)) THEN
                 osp$set_status_abnormal (oc, oce$container_overflow, 'word', status);
                 RETURN;
               IFEND;

               word_container^ := new_relocation_value;

             = llc$180_d_field =
               d_field_container := container_location;

               IF (new_relocation_value < LOWERVALUE (d_field_container^.d_portion)) OR
                     (new_relocation_value > UPPERVALUE (d_field_container^.d_portion)) THEN
                 osp$set_status_abnormal (oc, oce$container_overflow, 'd_field', status);
                 RETURN;
               IFEND;

               d_field_container^.d_portion := new_relocation_value;

             = llc$180_q_field =
               q_field_container := container_location;
               q_field_container^.q := new_relocation_value;

               IF (new_relocation_value < LOWERVALUE (q_field_container^.q)) OR
                     (new_relocation_value > UPPERVALUE (q_field_container^.q)) THEN
                 osp$set_status_abnormal (oc, oce$e_bound_module_too_large, module_name, status);
                 RETURN;
               IFEND;


             = llc$180_long_d_field =
               long_d_field_container := container_location;

               IF (new_relocation_value < LOWERVALUE (long_d_field_container^)) OR
                     (new_relocation_value > UPPERVALUE (long_d_field_container^)) THEN
                 osp$set_status_abnormal (oc, oce$container_overflow, 'd_field', status);
                 RETURN;
               IFEND;

               long_d_field_container^ := new_relocation_value;

             CASEND;

             IF bit_string_insertion_record <> NIL THEN
               FOR bit := 1 TO bit_string_insertion_record^.bit_length DO
                 bit_string_insertion_record^.bit_string [bit] :=
                       temp_bit_string.bit_array [bit + bit_string_insertion_record^.bit_offset];
               FOREND;
             IFEND;

           PROCEND replace_new_relocation_value;
?? OLDTITLE ??
?? NEWTITLE := '                  RELOCATE_NEW_CODE_SECTION' ??
?? EJECT ??

           PROCEDURE relocate_to_new_code_section
             (    component: oct$separated_module_header;
                  old_relocation: llt$relocation_item;
                  old_relocation_value: llt$section_offset;
                  new_relocation_item: llt$relocation_item;
                  temp_bit_string: bit_string_array;
              VAR bit_string_insertion_record: ^llt$bit_string_insertion;
              VAR container_location: ^cell;
              VAR status: ost$status);




             VAR
               new_relocation_value: ost$segment_offset;


             new_relocation_value := relocated_section_offset
                   (component, old_relocation.relocating_section, old_relocation_value);
             replace_new_relocation_value (new_relocation_item, temp_bit_string, component.header^.name,
                   new_relocation_value, bit_string_insertion_record, container_location, status);
             IF NOT status.normal THEN
               RETURN;
             IFEND;

             NEXT last_new_relocation^.link IN segment_4;
             last_new_relocation := last_new_relocation^.link;
             IF last_new_relocation = NIL THEN
               osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
               RETURN;
             IFEND;

             last_new_relocation^.link := NIL;
             last_new_relocation^.relocation_item := new_relocation_item;

             ocv$number_of_new_rel_items := ocv$number_of_new_rel_items + 1;

           PROCEND relocate_to_new_code_section;
?? OLDTITLE ??
?? NEWTITLE := '                  RELOCATE_EXT_TO_NEW_BINDING_SEC' ??
?? EJECT ??

           PROCEDURE relocate_ext_to_new_binding_sec
             (    component: oct$separated_module_header;
                  old_relocation_value: llt$section_offset;
                  new_relocation_item: llt$relocation_item;
                  old_binding_template_item: ^oct$old_binding_template_item;
                  instruction_location: ^cell;
                  temp_bit_string: bit_string_array;
              VAR bit_string_insertion_record: ^llt$bit_string_insertion;
              VAR container_location: ^cell;
              VAR status: ost$status);



             CONST
               two_to_the_plus_fifteenth = 8000(16),
               two_to_the_minus_fifteenth = -two_to_the_plus_fifteenth,
               callseg = 0b5(16);



             VAR
               external_found: boolean,

               entry_point_address_item: ^oct$entry_point_address_list,

               instruction: ^packed record
                 opcode: 0(16) .. 0ff(16),
                 j_field: 0(16) .. 0f(16),
                 k_field: 0(16) .. 0f(16),
                 q_field: oct$q_field,
               recend,

               new_binding_section_offset: ost$segment_offset,

               relocation_distance: integer;





             instruction := instruction_location;

             IF (new_relocation_item.container = llc$180_q_field) AND (instruction^.opcode = callseg) THEN
               search_entry_point_sorted_list (old_binding_template_item^.binding_template^.name,
                     external_found, entry_point_address_item);

               IF external_found THEN
                 IF entry_point_address_item^.section_ordinal = new_relocation_item.section_ordinal THEN
                   relocation_distance := (entry_point_address_item^.offset DIV 8) -
                         ((new_relocation_item.offset - 2) DIV 8);
                   IF (relocation_distance > two_to_the_minus_fifteenth) AND
                         (relocation_distance < two_to_the_plus_fifteenth) THEN

                     IF ((old_binding_template_item^.binding_template^.kind = llc$current_module) AND
                           (old_binding_template_item^.binding_template^.internal_address =
                           llc$internal_proc)) OR ((old_binding_template_item^.binding_template^.kind =
                           llc$external_reference) AND (old_binding_template_item^.binding_template^.address =
                           llc$internal_proc)) THEN
                       build_callrel_using_a3 (instruction_location, relocation_distance, status);

                     ELSEIF ((old_binding_template_item^.binding_template^.kind = llc$current_module) AND
                           (old_binding_template_item^.binding_template^.internal_address =
                           llc$external_proc)) OR ((old_binding_template_item^.binding_template^.kind =
                           llc$external_reference) AND (old_binding_template_item^.binding_template^.address =
                           llc$external_proc)) THEN
                       build_callrel_using_aj (instruction_location, relocation_distance, status);

                     ELSE
                       osp$set_status_abnormal (oc, oce$e_invalid_template_adr_kind, component.header^.name,
                             status);
                     IFEND;

                     RETURN;
                   IFEND;
                 IFEND;
               IFEND;
             IFEND;

             generate_binding_template_item (component, old_binding_template_item^.binding_template^.
                   binding_offset, new_binding_section_offset, status);
             ocv$number_of_new_rel_items := ocv$number_of_new_rel_items + 1;
             IF NOT status.normal THEN
               RETURN;
             IFEND;

             replace_new_relocation_value (new_relocation_item, temp_bit_string, component.header^.name,
                   new_binding_section_offset, bit_string_insertion_record, container_location, status);
             IF NOT status.normal THEN
               RETURN;
             IFEND;

             NEXT last_new_relocation^.link IN segment_4;
             last_new_relocation := last_new_relocation^.link;
             IF last_new_relocation = NIL THEN
               osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
               RETURN;
             IFEND;

             last_new_relocation^.link := NIL;
             last_new_relocation^.relocation_item := new_relocation_item;


           PROCEND relocate_ext_to_new_binding_sec;
?? OLDTITLE ??
?? NEWTITLE := '                  RELOCATE_NEW_MODULE_ADDRESS' ??
?? EJECT ??

           PROCEDURE relocate_new_module_address
             (    component: oct$separated_module_header;
                  old_relocation_value: llt$section_offset;
                  old_binding_template_item: ^oct$old_binding_template_item;
                  new_relocation_item: llt$relocation_item;
                  instruction_location: ^cell;
                  temp_bit_string: bit_string_array;
              VAR bit_string_insertion_record: ^llt$bit_string_insertion;
              VAR container_location: ^cell;
              VAR status: ost$status);



             CONST
               two_to_the_plus_fifteenth = 8000(16),
               two_to_the_minus_fifteenth = -two_to_the_plus_fifteenth,
               callseg = 0b5(16);




             VAR
               new_binding_section_offset: ost$segment_offset,
               procedure_section_ordinal: llt$section_ordinal,
               procedure_offset: llt$section_offset,
               instruction: ^packed record
                 opcode: 0(16) .. 0ff(16),
                 j_field: 0(16) .. 0f(16),
                 k_field: 0(16) .. 0f(16),
                 q_field: oct$q_field,
               recend,

               relocation_distance: integer;



             instruction := instruction_location;

             IF (new_relocation_item.container = llc$180_q_field) AND (instruction^.opcode = callseg) THEN
               relocated_section_ordinal (component, old_binding_template_item^.binding_template^.
                     section_ordinal, procedure_section_ordinal);

               IF procedure_section_ordinal = new_relocation_item.section_ordinal THEN
                 procedure_offset := relocated_section_offset (component,
                       old_binding_template_item^.binding_template^.section_ordinal,
                       old_binding_template_item^.binding_template^.offset);
                 relocation_distance := (procedure_offset DIV 8) - ((new_relocation_item.offset - 2) DIV 8);

                 IF (relocation_distance > two_to_the_minus_fifteenth) AND
                       (relocation_distance < two_to_the_plus_fifteenth) THEN

                   IF ((old_binding_template_item^.binding_template^.kind = llc$current_module) AND
                         (old_binding_template_item^.binding_template^.internal_address =
                         llc$internal_proc)) OR ((old_binding_template_item^.binding_template^.kind =
                         llc$external_reference) AND (old_binding_template_item^.binding_template^.address =
                         llc$internal_proc)) THEN
                     build_callrel_using_a3 (instruction_location, relocation_distance, status);

                   ELSEIF ((old_binding_template_item^.binding_template^.kind = llc$current_module) AND
                         (old_binding_template_item^.binding_template^.internal_address =
                         llc$external_proc)) OR ((old_binding_template_item^.binding_template^.kind =
                         llc$external_reference) AND (old_binding_template_item^.binding_template^.address =
                         llc$external_proc)) THEN
                     build_callrel_using_aj (instruction_location, relocation_distance, status);
                   ELSE
                     osp$set_status_abnormal (oc, oce$e_invalid_template_adr_kind, component.header^.name,
                           status);
                   IFEND;

                   RETURN;
                 IFEND;
               IFEND;
             IFEND;

             generate_binding_template_item (component, old_binding_template_item^.binding_template^.
                   binding_offset, new_binding_section_offset, status);
             ocv$number_of_new_rel_items := ocv$number_of_new_rel_items + 1;
             IF NOT status.normal THEN
               RETURN;
             IFEND;

             replace_new_relocation_value (new_relocation_item, temp_bit_string, component.header^.name,
                   new_binding_section_offset, bit_string_insertion_record, container_location, status);
             IF NOT status.normal THEN
               RETURN;
             IFEND;

             NEXT last_new_relocation^.link IN segment_4;
             last_new_relocation := last_new_relocation^.link;
             IF last_new_relocation = NIL THEN
               osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
               RETURN;
             IFEND;

             last_new_relocation^.link := NIL;
             last_new_relocation^.relocation_item := new_relocation_item;


           PROCEND relocate_new_module_address;
?? OLDTITLE ??
?? NEWTITLE := '                  [INLINE] RELOCATE_ADDRESS', EJECT ??

           PROCEDURE [INLINE] relocate_address
             (    component: oct$separated_module_header;
              VAR relocation: ^oct$relocation_item_list;
              VAR status: ost$status);

             VAR
               bit_string_insertion_record: ^llt$bit_string_insertion,
               container_location: ^cell,
               instruction_location: ^cell,
               item_number: integer,
               new_relocation_item: llt$relocation_item,
               old_binding_template_item: ^oct$old_binding_template_item,
               old_relocation_item: llt$relocation_item,
               old_relocation_value: llt$section_offset,
               temp_bit_string: bit_string_array;

             status.normal := TRUE;

             WHILE relocation <> NIL DO
               old_relocation_item := relocation^.item^;

               new_relocation_item := old_relocation_item;
               bit_string_insertion_record := NIL;

               fetch_old_relocation_value (component, old_relocation_item, old_relocation_value,
                     new_relocation_item, container_location, instruction_location, temp_bit_string,
                     bit_string_insertion_record, status);
               IF NOT status.normal THEN
                 RETURN;
               IFEND;

               relocated_section_ordinal (component, old_relocation_item.relocating_section,
                     new_relocation_item.relocating_section);

               CASE component.section_definitions^ [old_relocation_item.relocating_section]^.
                     section_definition.kind OF

               = llc$code_section =
                 relocate_to_new_code_section (component, old_relocation_item, old_relocation_value,
                       new_relocation_item, temp_bit_string, bit_string_insertion_record, container_location,
                       status);
                 IF NOT status.normal THEN
                   RETURN;
                 IFEND;

               = llc$binding_section =
                 get_old_binding_template_item (component, old_relocation_value, old_binding_template_item,
                       status);
                 IF NOT status.normal THEN
                   RETURN;
                 IFEND;

                 IF old_binding_template_item^.binding_template^.kind = llc$external_reference THEN
                   relocate_ext_to_new_binding_sec (component, old_relocation_value, new_relocation_item,
                         old_binding_template_item, instruction_location, temp_bit_string,
                         bit_string_insertion_record, container_location, status);
                   IF NOT status.normal THEN
                     RETURN;
                   IFEND;

                 ELSE
                   relocate_new_module_address (component, old_relocation_value, old_binding_template_item,
                         new_relocation_item, instruction_location, temp_bit_string,
                         bit_string_insertion_record, container_location, status);
                   IF NOT status.normal THEN
                     RETURN;
                   IFEND;

                 IFEND;
               ELSE
                 osp$set_status_abnormal (oc, oce$e_relocating_sec_wrong_kind, component.header^.name,
                       status);
                 RETURN;
               CASEND;

               relocation := relocation^.link;
             WHILEND;
           PROCEND relocate_address;
?? OLDTITLE ??
?? EJECT ??

           TYPE
             bit_string_array = record
               case 0 .. 1 of

               = 0 =
                 bit_array: packed array [1 .. 70] of 0 .. 1,

               = 1 =
                 byte_array: array [1 .. 9] of 0 .. 0ff(16),
               casend,
             recend;

           VAR
             i: llt$module_index,
             last_new_relocation: ^oct$relocation_list,
             relocation: ^oct$relocation_item_list;

           status.normal := TRUE;

           last_new_relocation := ^new_relocation_list;

           FOR i := 1 TO UPPERBOUND (separated_components^) DO
             relocation := separated_components^ [i].relocation_list.byte.link;

             relocate_address (separated_components^ [i], relocation, status);
             IF NOT status.normal THEN
               RETURN;
             IFEND;
           FOREND;

           FOR i := 1 TO UPPERBOUND (separated_components^) DO
             relocation := separated_components^ [i].relocation_list.two_byte.link;

             relocate_address (separated_components^ [i], relocation, status);
             IF NOT status.normal THEN
               RETURN;
             IFEND;
           FOREND;

           FOR i := 1 TO UPPERBOUND (separated_components^) DO
             relocation := separated_components^ [i].relocation_list.four_byte.link;

             relocate_address (separated_components^ [i], relocation, status);
             IF NOT status.normal THEN
               RETURN;
             IFEND;
           FOREND;

           FOR i := 1 TO UPPERBOUND (separated_components^) DO
             relocation := separated_components^ [i].relocation_list.eight_byte.link;

             relocate_address (separated_components^ [i], relocation, status);
             IF NOT status.normal THEN
               RETURN;
             IFEND;
           FOREND;

         PROCEND process_relocation_records;
?? OLDTITLE ??
?? NEWTITLE := '                PROCESS_ADR_FORMULATION_RECORDS' ??
?? EJECT ??

         PROCEDURE process_adr_formulation_records
           (    separated_components: ^oct$separated_components;
            VAR status: ost$status);



           VAR
             address_formulation: ^oct$address_formulation_list,
             address_formulation_item: llt$address_formulation_item,

             i: llt$module_index,
             item_number: integer,

             new_dest_section_ordinal: llt$section_ordinal,
             new_value_section_ordinal: llt$section_ordinal,
             new_dest_offset: llt$section_offset,
             new_value_offset: ost$segment_offset;





           FOR i := 1 TO UPPERBOUND (separated_components^) DO
             address_formulation := separated_components^ [i].address_formulation_list;

             WHILE address_formulation <> NIL DO
               IF separated_components^ [i].section_definitions^
                     [address_formulation^.address_formulation.dest_section]^.section_definition.kind <>
                     llc$binding_section THEN

                 relocated_section_ordinal (separated_components^ [i],
                       address_formulation^.address_formulation.dest_section, new_dest_section_ordinal);
                 relocated_section_ordinal (separated_components^ [i],
                       address_formulation^.address_formulation.value_section, new_value_section_ordinal);

                 FOR item_number := LOWERBOUND (address_formulation^.address_formulation.item)
                       TO UPPERBOUND (address_formulation^.address_formulation.item) DO

                   address_formulation_item := address_formulation^.address_formulation.item [item_number];
                   new_dest_offset := relocated_section_offset (separated_components^ [i],
                         address_formulation^.address_formulation.dest_section,
                         address_formulation_item.dest_offset);

                   IF separated_components^ [i].section_definitions^
                         [address_formulation^.address_formulation.value_section]^.section_definition.kind =
                         llc$binding_section THEN

                     generate_binding_template_item (separated_components^ [i],
                           address_formulation_item.value_offset, new_value_offset, status);
                     IF NOT status.normal THEN
                       RETURN;
                     IFEND;
                   ELSE
                     new_value_offset := relocated_section_offset
                           (separated_components^ [i], address_formulation^.address_formulation.value_section,
                           address_formulation_item.value_offset);
                   IFEND;

                   build_new_adr_record (new_dest_section_ordinal, new_dest_offset, new_value_section_ordinal,
                         new_value_offset, address_formulation_item.kind, 0, status);
                   IF NOT status.normal THEN
                     RETURN;
                   IFEND;
                 FOREND;
               IFEND;

               address_formulation := address_formulation^.link;
             WHILEND;

           FOREND;

         PROCEND process_adr_formulation_records;
?? OLDTITLE ??
?? NEWTITLE := '                PROCESS_EXT_LINKAGE_RECORDS' ??
?? EJECT ??

         PROCEDURE process_ext_linkage_records
           (    separated_components: ^oct$separated_components;
            VAR status: ost$status);




           VAR
             component: ^oct$separated_components,
             external_found: boolean,
             actual_parameter: ^oct$actual_parameter_list,
             external_linkage: ^oct$external_linkage_list,
             external_linkage_item: llt$external_linkage_item,
             entry_point_address_item: ^oct$entry_point_address_list,
             link: ^oct$external_linkage_item,
             i: llt$module_index,
             item_number: integer,

             new_dest_section_ordinal: llt$section_ordinal,
             new_dest_offset: llt$section_offset,

             new_value_section_ordinal: llt$section_ordinal,
             new_value_offset: ost$segment_offset;



           FOR i := 1 TO UPPERBOUND (separated_components^) DO
             external_linkage := separated_components^ [i].external_linkage_list;

             WHILE external_linkage <> NIL DO
               FOR item_number := LOWERBOUND (external_linkage^.external_linkage.item)
                     TO UPPERBOUND (external_linkage^.external_linkage.item) DO

                 external_linkage_item := external_linkage^.external_linkage.item [item_number];

                 IF separated_components^ [i].section_definitions^ [external_linkage_item.section_ordinal]^.
                       section_definition.kind <> llc$binding_section THEN

                   relocated_section_ordinal (separated_components^ [i],
                         external_linkage_item.section_ordinal, new_dest_section_ordinal);
                   new_dest_offset := relocated_section_offset (separated_components^ [i],
                         external_linkage_item.section_ordinal, external_linkage_item.offset);
                   search_entry_point_sorted_list (external_linkage^.external_linkage.name, external_found,
                         entry_point_address_item);

                   IF external_found THEN
                     IF entry_point_address_item^.defined THEN
                       new_value_section_ordinal := entry_point_address_item^.section_ordinal;
                       new_value_offset := entry_point_address_item^.offset;
                     ELSE
                       generate_binding_template_item (entry_point_address_item^.component^,
                             entry_point_address_item^.old_binding_offset, new_value_offset, status);
                       IF NOT status.normal THEN
                         RETURN;
                       IFEND;

                       new_value_section_ordinal := ocv$new_binding_section_ordinal;
                     IFEND;

                     build_new_adr_record (new_dest_section_ordinal, new_dest_offset,
                           new_value_section_ordinal, new_value_offset, external_linkage_item.kind,
                           external_linkage_item.offset_operand, status);
                     IF NOT status.normal THEN
                       RETURN;
                     IFEND;
                   ELSE
                     build_new_ext_record (external_linkage, new_dest_section_ordinal, new_dest_offset,
                           external_linkage_item.kind, external_linkage_item.offset_operand, status);
                     IF NOT status.normal THEN
                       RETURN;
                     IFEND;
                   IFEND;
                 IFEND;
               FOREND;
               IF (external_linkage^.actual_parameter_list.nnext <> NIL) THEN
                 link := temporary_module_header^.external_linkage_items.link;

               /loop/
                 WHILE link <> NIL DO
                   IF link^.name = external_linkage^.external_linkage.name THEN
                     IF (link^.actual_parameter_list = NIL) THEN
                       link^.actual_parameter_list := external_linkage^.actual_parameter_list.nnext;
                     ELSE
                       actual_parameter := link^.actual_parameter_list;
                       WHILE actual_parameter^.nnext <> NIL DO
                         actual_parameter := actual_parameter^.nnext;
                       WHILEND;
                       actual_parameter^.nnext := external_linkage^.actual_parameter_list.nnext;
                     IFEND;
                     EXIT /loop/;
                   ELSE
                     link := link^.link;
                   IFEND;
                 WHILEND /loop/;
               IFEND;
               external_linkage := external_linkage^.link;
             WHILEND;

           FOREND;

         PROCEND process_ext_linkage_records;
?? OLDTITLE ??
?? EJECT ??



         VAR
           entry_point_address_list: oct$entry_point_address_list,
           entry_point_sorted_list: oct$entry_point_sorted_list,
           ocv$last_new_adr_formulation: ^oct$address_formulation_item,
           ocv$last_new_binding_template: ^oct$new_binding_template_list,
           ocv$last_new_external: ^oct$external_linkage_item,

           ocv$number_of_new_temp_items: integer,
           ocv$number_of_new_rel_items: integer,


           ocv$new_binding_section_ordinal: llt$section_ordinal,
           ocv$next_avail_binding_offset: llt$section_offset;




         ocv$number_of_new_temp_items := 0;
         ocv$number_of_new_rel_items := 0;

         IF ocv$binding_section <> NIL THEN
           ocv$new_binding_section_ordinal := ocv$binding_section^.section_definition.section_ordinal;
           ocv$next_avail_binding_offset := 0;
         IFEND;

         ocv$last_new_adr_formulation := ^temporary_module_header^.address_formulation_items;
         ocv$last_new_adr_formulation^.link := NIL;
         ocv$last_new_external := ^temporary_module_header^.external_linkage_items;
         ocv$last_new_external^.link := NIL;
         ocv$last_new_binding_template := ^temporary_module_header^.binding_template_list;


         build_new_entry_point_defn (separated_components, temporary_module_header^.starting_procedure,
               entry_point_address_list, ^temporary_module_header^.entry_definition_list,
               temporary_module_header^.number_of_entry_definitions,
               temporary_module_header^.identification.attributes, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;

         process_relocation_records (separated_components, temporary_module_header^.relocation_list, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;

         process_adr_formulation_records (separated_components, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;

         process_ext_linkage_records (separated_components, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;

         IF ocv$number_of_new_rel_items > llc$max_info_elements THEN
           osp$set_status_abnormal (oc, oce$e_too_many_relocation_items,
                 temporary_module_header^.identification.name, status);
           RETURN;
         ELSE
           temporary_module_header^.number_of_rel_items := ocv$number_of_new_rel_items;
         IFEND;

         IF ocv$number_of_new_temp_items > llc$max_info_elements THEN
           osp$set_status_abnormal (oc, oce$e_too_many_template_items,
                 temporary_module_header^.identification.name, status);
           RETURN;
         ELSE
           temporary_module_header^.number_of_template_items := ocv$number_of_new_temp_items;
         IFEND;

         IF ocv$binding_section <> NIL THEN
           IF ocv$next_avail_binding_offset <> 0 THEN
             ocv$binding_section^.section_definition.length := ocv$next_avail_binding_offset;
           ELSE

{ Delete the binding section definition

             ocv$binding_section := ^temporary_module_header^.section_definitions;
             WHILE ocv$binding_section^.link^.section_definition.kind <> llc$binding_section DO
               ocv$binding_section := ocv$binding_section^.link;
             WHILEND;

             ocv$binding_section^.link := ocv$binding_section^.link^.link;
           IFEND;
         IFEND;

         combine_ext_records (temporary_module_header^.external_linkage_items.link,
               temporary_module_header^.external_linkage_list, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;

         combine_adr_records (temporary_module_header^.address_formulation_items.link,
               temporary_module_header^.address_formulation_list, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;

         collect_miscellaneous_records (separated_components,
               temporary_module_header^.miscellaneous_record_list, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;


       PROCEND bind_module;
?? OLDTITLE ??
?? NEWTITLE := '              PRINT_SECTION_MAP', EJECT ??

       PROCEDURE print_section_map
         (    temporary_module_header: ^oct$temporary_module_header;
              map_file: clt$file;
          VAR status: ost$status);


         VAR
           next_section: ^oct$section_definition_list,
           old_section: ^oct$old_section_list,

           page_header: string (62),
           line: [STATIC] string (123) := '   offset: ########  length: ########  module:             ' CAT
                 '                        section:',
           str: ost$string,
           section_name: pmt$program_name,
           valid: boolean,
           ignore: ost$status;


         page_header := 'Display of sections for module ';
         page_header (32, 31) := temporary_module_header^.identification.name;

         ocp$open_output_file (map_file.local_file_name, ^page_header, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;


         ocp$output (occ$triple_space, 'Section map for module ', 23, occ$continue);
         ocp$output (' ', temporary_module_header^.identification.name, 31, occ$continue);
         ocp$output ('    ', 'created:', 8, occ$continue);
         ocp$output_time (^temporary_module_header^.identification.time_created, occ$continue, valid);
         ocp$output ('', ' ', 1, occ$continue);
         ocp$output_date (^temporary_module_header^.identification.date_created, occ$end_of_line, valid);
         ocp$output (occ$single_space, '', 0, occ$end_of_line);

         next_section := temporary_module_header^.section_definitions.link;

         WHILE next_section <> NIL DO
           ocp$output (occ$triple_space, 'kind:', 5, occ$continue);
           ocp$output_section_kind (^next_section^.section_definition.kind, occ$continue, valid);

           clp$convert_integer_to_string (next_section^.section_definition.length, 16, FALSE, str, ignore);
           ocp$output ('  length: ', str.value, str.size, occ$continue);

           IF next_section^.section_definition.name <> osc$null_name THEN
             ocp$output ('  name: ', next_section^.section_definition.name, 31, occ$end_of_line);
           ELSE
             ocp$output ('', ' ', 1, occ$end_of_line);
           IFEND;

           ocp$output (' ', ' ', 1, occ$end_of_line);

           IF (next_section^.section_definition.kind <> llc$binding_section) THEN
             old_section := next_section^.old_sections.link;

             WHILE old_section <> NIL DO
               clp$convert_integer_to_string (old_section^.component^.
                     section_definitions^ [old_section^.section_ordinal]^.new_section_offset, 16, FALSE, str,
                     ignore);
               line (12, 8) := str.value (1, str.size);

               clp$convert_integer_to_string (old_section^.component^.
                     section_definitions^ [old_section^.section_ordinal]^.section_definition.length, 16,
                     FALSE, str, ignore);
               line (30, 8) := str.value (1, str.size);

               line (48, 31) := old_section^.component^.header^.name;

               section_name := old_section^.component^.section_definitions^ [old_section^.section_ordinal]^.
                     section_definition.name;

               IF section_name = osc$null_name THEN
                 ocp$output ('', line, 78, occ$end_of_line);
               ELSE
                 line (93, * ) := section_name;
                 ocp$output ('', line, 123, occ$end_of_line);
               IFEND;

               old_section := old_section^.link;
             WHILEND;
           IFEND;

           next_section := next_section^.link;
         WHILEND;


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


       PROCEND print_section_map;
?? OLDTITLE ??
?? EJECT ??


       VAR
         changed_entry_points: ^oct$external_declaration_list,
         debug_tables_to_omit: oct$debug_tables,
         separated_components: ^oct$separated_components,

         current_section_ordinal: 0 .. llc$max_section_ordinal + 1,
         i: llt$module_index,
         collect_component_libraries: boolean,
         number_of_binding_sections: integer,
         binding_sections: ^oct$section_definition_list;


{ SEPARATE BOUND MODULE COMPONENTS


       NEXT separated_components: [1 .. UPPERBOUND (bound_module.components^)] IN segment_1;
       IF separated_components = NIL THEN
         osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
         RETURN;
       IFEND;

       IF (changed_info <> NIL) THEN
         debug_tables_to_omit := changed_info^.debug_tables_to_omit;

         IF (changed_info^.entry_points <> NIL) THEN
           changed_entry_points := changed_info^.entry_points;
         ELSE
           changed_entry_points := NIL;
         IFEND;
       ELSE
         changed_entry_points := NIL;
         debug_tables_to_omit := $oct$debug_tables [];
       IFEND;

       separate_components (bound_module.components, debug_tables_to_omit, changed_entry_points,
             separated_components, status);

       IF NOT status.normal THEN
         RETURN;
       IFEND;

{ INITIAL TEMPORARY_MODULE_HEADER


       temporary_module_header^.identification := bound_module.identification;
       IF quick_bind THEN
         temporary_module_header^.application_identifier := separated_components^ [1].application_identifier;
         temporary_module_header^.deferred_common_blocks := separated_components^ [1].deferred_common_blocks;
       ELSE
         temporary_module_header^.application_identifier := NIL;
         temporary_module_header^.deferred_common_blocks := NIL;
         temporary_module_header^.deferred_entry_points := NIL;
       IFEND;

       IF changed_info <> NIL THEN
         IF changed_info^.name <> NIL THEN
           temporary_module_header^.identification.name := changed_info^.name^;
         IFEND;

         IF changed_info^.commentary <> NIL THEN
           temporary_module_header^.identification.commentary := changed_info^.commentary^;
         IFEND;

         IF changed_info^.entry_points <> NIL THEN
           temporary_module_header^.starting_procedure := changed_info^.starting_procedure;
         ELSE
           temporary_module_header^.starting_procedure := separated_components^
                 [UPPERBOUND (separated_components^)].starting_procedure;
         IFEND;

         IF changed_info^.new_libraries THEN
           temporary_module_header^.library_list.link := changed_info^.library_list;
           collect_component_libraries := FALSE;
         ELSE
           temporary_module_header^.library_list.link := NIL;
           collect_component_libraries := TRUE;
         IFEND;

         IF changed_info^.application_identifier <> NIL THEN
           temporary_module_header^.application_identifier := changed_info^.application_identifier;
         IFEND;

         IF changed_info^.cybil_parameter_checking = object_type_checking THEN
           temporary_module_header^.identification.attributes :=
                 temporary_module_header^.identification.attributes +
                 $llt$module_attributes [llc$object_cybil_checking];
         ELSE
           temporary_module_header^.identification.attributes :=
                 temporary_module_header^.identification.attributes -
                 $llt$module_attributes [llc$object_cybil_checking];
         IFEND;

       ELSE
         temporary_module_header^.starting_procedure := separated_components^
               [UPPERBOUND (separated_components^)].starting_procedure;
         temporary_module_header^.library_list.link := NIL;
         collect_component_libraries := TRUE;
       IFEND;

       temporary_module_header^.section_definitions.link := NIL;

       temporary_module_header^.number_of_entry_definitions := 0;
       temporary_module_header^.entry_definition_list.link := NIL;

       temporary_module_header^.external_linkage_list := NIL;
       temporary_module_header^.external_linkage_items.link := NIL;
       temporary_module_header^.address_formulation_list := NIL;
       temporary_module_header^.address_formulation_items.link := NIL;

       temporary_module_header^.miscellaneous_record_list.link := NIL;

       temporary_module_header^.number_of_rel_items := 0;
       temporary_module_header^.relocation_list.link := NIL;

       temporary_module_header^.number_of_template_items := 0;
       temporary_module_header^.binding_template_list.link := NIL;

{ COLLECT SEPARATED COMPONENT INFO, LIBRARIES, SECTION DEFINITIONS, AND CODE SECTIONS

       collect_component_info (separated_components, temporary_module_header^.component_info, status);
       IF NOT status.normal THEN
         RETURN;
       IFEND;


       ocv$binding_section := NIL;
       current_section_ordinal := 0;

       FOR i := 1 TO UPPERBOUND (separated_components^) DO
         IF collect_component_libraries THEN
           collect_libraries (separated_components^ [i], temporary_module_header^.library_list, status);
           IF NOT status.normal THEN
             RETURN;
           IFEND;
         IFEND;


         collect_section_records (separated_components^ [i], current_section_ordinal,
               temporary_module_header^.section_definitions, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;

       FOREND;


{ BIND THE SEPARATED COMPONENTS


       IF bound_module.code_section_ids.link <> NIL THEN
         sort_code_sections (bound_module.code_section_ids, temporary_module_header^.section_definitions);
       IFEND;


       build_composite_sections (temporary_module_header^.section_definitions, status);
       IF NOT status.normal THEN
         RETURN;
       IFEND;


       IF quick_bind THEN
         quick_bind_module (separated_components, temporary_module_header, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;
       ELSE
         bind_module (separated_components, temporary_module_header, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;
       IFEND;


       number_of_binding_sections := 0;
       binding_sections := temporary_module_header^.section_definitions.link;

       WHILE binding_sections <> NIL DO
         IF binding_sections^.section_definition.kind = llc$binding_section THEN
           number_of_binding_sections := number_of_binding_sections + 1;
         IFEND;
         binding_sections := binding_sections^.link;
       WHILEND;

       IF number_of_binding_sections > 1 THEN
         osp$set_status_abnormal ('OC', oce$e_multiple_binding_sections,
               temporary_module_header^.identification.name, status);
         RETURN;
       IFEND;

       IF bound_module.section_map.local_file_name <> osc$null_name THEN
         print_section_map (temporary_module_header, bound_module.section_map, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;
       IFEND;


       temporary_module_header^.include_binary_section_maps :=
             (bound_module.include_binary_section_maps AND (temporary_module_header^.section_definitions.
             link <> NIL));


     PROCEND change_bound_to_temp_module;
?? OLDTITLE ??
?? EJECT ??


     VAR
       bound_module_header: oct$bound_module_header;


     NEXT temporary_load_module IN ocv$olg_scratch_seq;
     IF temporary_load_module = NIL THEN
       osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
       RETURN;
     IFEND;

     temporary_load_module^.kind := occ$temporary_load_module;

{ Set to NIL so that write_header_interpretive_info can reference the file field
{ of the load_module_header without getting a ring zero fault.

     temporary_load_module^.file := NIL;

     NEXT temporary_load_module^.temporary_module_header IN ocv$olg_scratch_seq;
     IF temporary_load_module^.temporary_module_header = NIL THEN
       osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
       RETURN;
     IFEND;


     CASE module_description^.kind OF
     = occ$cpu_object_module =
       quick_bind := TRUE;
       bound_module_header.identification := module_description^.cpu_object_module_header^.identification^;
       bound_module_header.section_map.local_file_name := osc$null_name;

       bound_module_header.xref_list.link := NIL; { NEVER used in 'change_bound_to_temp_module'}

       NEXT bound_module_header.components: [1 .. 1] IN ocv$olg_scratch_seq;
       IF bound_module_header.components = NIL THEN
         osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
         RETURN;
       IFEND;
       bound_module_header.components^ [1] := module_description;

       bound_module_header.code_section_ids.link := NIL;
       bound_module_header.preset_specified := FALSE;
       bound_module_header.preset_value := pmc$initialize_to_zero;
       bound_module_header.include_binary_section_maps := FALSE;

       change_bound_to_temp_module (bound_module_header, changed_info,
             temporary_load_module^.temporary_module_header, status);


     = occ$bound_module =
       quick_bind := FALSE;
       change_bound_to_temp_module (module_description^.bound_module_header^, changed_info,
             temporary_load_module^.temporary_module_header, status);

     CASEND;


   PROCEND build_temporary_load_module;
?? OLDTITLE ??
?? EJECT ??


   VAR
     nlm: ^oct$new_library_module_list,
     load_module: ^oct$load_module_list,

     temporary_load_module: ^oct$module_description,

     local_status: ost$status;


   local_status.normal := TRUE;

   nlm := nlm_list^.f_link;
   load_module := ^load_module_list;

   REPEAT
     NEXT load_module^.link IN ocv$olg_scratch_seq;
     load_module := load_module^.link;

     IF load_module = NIL THEN
       osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
       RETURN;
     IFEND;

     load_module^.name := nlm^.name;

     CASE nlm^.description^.kind OF
     = occ$cpu_object_module, occ$bound_module =
       build_temporary_load_module (nlm^.description, nlm^.changed_info, temporary_load_module, local_status);

       IF local_status.normal THEN
         load_module^.description := temporary_load_module;
         load_module^.changed_info := NIL;
       IFEND;

     = occ$ppu_object_module, occ$program_description, occ$command_procedure, occ$function_procedure,
           occ$message_module, occ$panel_module, occ$load_module, occ$applic_program_description,
           occ$applic_command_procedure, occ$applic_command_description, occ$command_description,
           occ$function_description =
       load_module^.description := nlm^.description;
       load_module^.changed_info := nlm^.changed_info;

     ELSE
       osp$set_status_abnormal (oc, oce$e_invalid_module_kind, nlm^.name, local_status);

     CASEND;

     IF NOT local_status.normal THEN
       ocp$generate_message (local_status);
       osp$set_status_abnormal (oc, oce$w_new_file_not_generated, '', status);
     IFEND;

     nlm := nlm^.f_link;

   UNTIL nlm^.name = osc$null_name;

   load_module^.link := NIL;



 PROCEND build_load_module_list;
?? OLDTITLE ??
?? NEWTITLE := '        GENERATE_TEMPORARY_LIBRARY' ??
?? EJECT ??


 PROCEDURE generate_temporary_library
   (    load_module_list: oct$load_module_list;
    VAR temporary_library: ^SEQ ( * );
    VAR status: ost$status);

?? NEWTITLE := '          SKIP_TO_PAGE_BOUNDRY' ??
?? EJECT ??

   PROCEDURE skip_to_page_boundry
     (    page_size: ost$page_size;
      VAR temporary_library: ^SEQ ( * ));


     VAR
       temp: ost$segment_length,
       valid_position: boolean,
       sequence_ptr: ost$segment_length;


     sequence_ptr := i#current_sequence_position (temporary_library);

     IF (sequence_ptr MOD page_size) <> 0 THEN
       temp := sequence_ptr + page_size;
       sequence_ptr := (temp - (temp MOD page_size));
       pmp$position_object_library (temporary_library, sequence_ptr, valid_position);
       IF NOT valid_position THEN
         osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
         RETURN;
       IFEND;
     IFEND;


   PROCEND skip_to_page_boundry;
?? OLDTITLE ??
?? NEWTITLE := '          WRITE_HEADER_AND_DICTIONARIES' ??
?? EJECT ??

   PROCEDURE write_header_and_dictionaries
     (    load_module_list: oct$load_module_list;
      VAR module_dictionary: ^llt$module_dictionary;
      VAR entry_point_dictionary: ^llt$entry_point_dictionary;
      VAR command_dictionary: ^llt$command_dictionary;
      VAR function_dictionary: ^llt$function_dictionary;
      VAR help_module_dictionary: ^llt$help_module_dictionary;
      VAR message_module_dictionary: ^llt$message_module_dictionary;
      VAR panel_dictionary: ^llt$panel_dictionary;
      VAR new_library: ^SEQ ( * );
      VAR status: ost$status);

?? NEWTITLE := '            OBTAIN_DICTIONARY_SIZES' ??
?? EJECT ??

{ NOTE:
{   Only save the current_segment_number and current_offset for those records
{ that require the module description to be referenced.

     PROCEDURE obtain_dictionary_sizes
       (    module_description: ^oct$module_description;
            changed_info: ^oct$changed_info;
        VAR dictionary_sizes: dictionary_size_info;
        VAR status: ost$status);


       VAR
         next_entry_point: ^oct$external_declaration_list,

         library: ^SEQ ( * ),
         library_member_header: ^llt$library_member_header,
         message_template_module: ^ost$message_template_module,

         natural_language: ost$natural_language,
         online_manual_name: ost$online_manual_name,
         help_module: boolean,
         message_module: boolean,
         lowest_message_code: ost$status_condition_code,
         highest_message_code: ost$status_condition_code,

         object_text_descriptor: ^llt$object_text_descriptor,
         transfer_symbol: ^llt$transfer_symbol,
         entry_definition: ^llt$entry_definition;

       library := temporary_library;


       IF (changed_info <> NIL) AND (changed_info^.entry_points <> NIL) THEN

         next_entry_point := changed_info^.entry_points;

         REPEAT
           IF next_entry_point^.name <> osc$null_name THEN
             CASE module_description^.kind OF

             = occ$load_module, occ$temporary_load_module =
               dictionary_sizes.number_of_entry_points := dictionary_sizes.number_of_entry_points + 1;

             = occ$program_description, occ$command_procedure, occ$applic_program_description,
                   occ$applic_command_procedure, occ$applic_command_description, occ$command_description =
               dictionary_sizes.number_of_commands := dictionary_sizes.number_of_commands + 1;

             = occ$function_procedure, occ$function_description =
               dictionary_sizes.number_of_functions := dictionary_sizes.number_of_functions + 1;

             ELSE

             CASEND;
           IFEND;

           next_entry_point := next_entry_point^.link;
         UNTIL next_entry_point = NIL;

         IF changed_info^.starting_procedure <> osc$null_name THEN
           dictionary_sizes.number_of_commands := dictionary_sizes.number_of_commands + 1;
         IFEND;

         CASE module_description^.kind OF

         = occ$load_module, occ$temporary_load_module =

         = occ$program_description, occ$command_procedure, occ$applic_program_description,
               occ$applic_command_procedure, occ$applic_command_description, occ$command_description =
           dictionary_sizes.number_of_commands := dictionary_sizes.number_of_commands + 1;

         = occ$function_procedure, occ$function_description =
           dictionary_sizes.number_of_functions := dictionary_sizes.number_of_functions + 1;

         CASEND;

       ELSE

         CASE module_description^.kind OF

         = occ$temporary_load_module =

           IF module_description^.temporary_module_header^.starting_procedure <> osc$null_name THEN
             dictionary_sizes.number_of_commands := dictionary_sizes.number_of_commands + 1;
           IFEND;

           dictionary_sizes.number_of_entry_points := dictionary_sizes.number_of_entry_points +
                 module_description^.temporary_module_header^.number_of_entry_definitions;
           current_segment_number := #SEGMENT (module_description^.temporary_module_header);
           current_offset := #OFFSET (module_description^.temporary_module_header);

         = occ$load_module =

           IF (llc$interpretive_element IN module_description^.load_module_header^.elements_defined) AND
                 (llc$transfer_symbol_element IN module_description^.load_module_header^.interpretive_header.
                 elements_defined) THEN

             object_text_descriptor := #PTR (module_description^.load_module_header^.interpretive_header.
                   transfer_symbol, module_description^.file^);
             IF object_text_descriptor = NIL THEN
               osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description^.name, status);
               RETURN;
             IFEND;

             RESET module_description^.file TO object_text_descriptor;
             NEXT object_text_descriptor IN module_description^.file;
             NEXT transfer_symbol IN module_description^.file;
             IF transfer_symbol^.name <> osc$null_name THEN
               dictionary_sizes.number_of_commands := dictionary_sizes.number_of_commands + 1;
             IFEND;

           IFEND;

           IF llc$entry_point_element IN module_description^.load_module_header^.interpretive_header.
                 elements_defined THEN
             object_text_descriptor := #PTR (module_description^.load_module_header^.interpretive_header.
                   entry_points, module_description^.file^);
             IF object_text_descriptor = NIL THEN
               osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description^.name, status);
               RETURN;
             IFEND;

             IF object_text_descriptor^.kind = llc$entry_definition THEN
               RESET module_description^.file TO object_text_descriptor;
               NEXT object_text_descriptor IN module_description^.file;

               REPEAT
                 NEXT entry_definition IN module_description^.file;
                 IF entry_definition = NIL THEN
                   osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description^.name,
                         status);
                   RETURN;
                 IFEND;

                 dictionary_sizes.number_of_entry_points := dictionary_sizes.number_of_entry_points + 1;

                 NEXT object_text_descriptor IN module_description^.file;
                 IF object_text_descriptor = NIL THEN
                   osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, module_description^.name,
                         status);
                   RETURN;
                 IFEND;

               UNTIL object_text_descriptor^.kind <> llc$entry_definition;
             IFEND;
           IFEND;
           current_segment_number := #SEGMENT (module_description^.load_module_header);
           current_offset := #OFFSET (module_description^.load_module_header);

         = occ$program_description =
           dictionary_sizes.number_of_commands := dictionary_sizes.number_of_commands +
                 module_description^.program_description_header^.number_of_aliases + 1;
           current_segment_number := #SEGMENT (module_description^.program_description_header);
           current_offset := #OFFSET (module_description^.program_description_header);

         = occ$command_procedure =
           dictionary_sizes.number_of_commands := dictionary_sizes.number_of_commands +
                 module_description^.command_procedure_header^.number_of_aliases + 1;
           current_segment_number := #SEGMENT (module_description^.command_procedure_header);
           current_offset := #OFFSET (module_description^.command_procedure_header);

         = occ$command_description =
           dictionary_sizes.number_of_commands := dictionary_sizes.number_of_commands +
                 module_description^.command_description_header^.number_of_aliases + 1;
           current_segment_number := #SEGMENT (module_description^.command_description_header);
           current_offset := #OFFSET (module_description^.command_description_header);

         = occ$applic_program_description =
           dictionary_sizes.number_of_commands := dictionary_sizes.number_of_commands +
                 module_description^.applic_program_description_hdr^.library_member_header.number_of_aliases +
                 1;
           current_segment_number := #SEGMENT (module_description^.applic_program_description_hdr);
           current_offset := #OFFSET (module_description^.applic_program_description_hdr);

         = occ$applic_command_procedure =
           dictionary_sizes.number_of_commands := dictionary_sizes.number_of_commands +
                 module_description^.applic_command_procedure_header^.library_member_header.
                 number_of_aliases + 1;
           current_segment_number := #SEGMENT (module_description^.applic_command_procedure_header);
           current_offset := #OFFSET (module_description^.applic_command_procedure_header);

         = occ$applic_command_description =
           dictionary_sizes.number_of_commands := dictionary_sizes.number_of_commands +
                 module_description^.applic_command_description_hdr^.library_member_header.number_of_aliases +
                 1;
           current_segment_number := #SEGMENT (module_description^.applic_command_description_hdr);
           current_offset := #OFFSET (module_description^.applic_command_description_hdr);

         = occ$function_procedure =
           dictionary_sizes.number_of_functions := dictionary_sizes.number_of_functions +
                 module_description^.function_procedure_header^.number_of_aliases + 1;
           current_segment_number := #SEGMENT (module_description^.function_procedure_header);
           current_offset := #OFFSET (module_description^.function_procedure_header);

         = occ$function_description =
           dictionary_sizes.number_of_functions := dictionary_sizes.number_of_functions +
                 module_description^.function_description_header^.number_of_aliases + 1;
           current_segment_number := #SEGMENT (module_description^.function_description_header);
           current_offset := #OFFSET (module_description^.function_description_header);

         = occ$message_module =

           library_member_header := module_description^.message_module_header;
           RESET module_description^.file TO library_member_header;
           message_template_module := #PTR (library_member_header^.member, module_description^.file^);

           RESET message_template_module;
           clp$get_message_module_info (message_template_module, natural_language, online_manual_name,
                 help_module, message_module, lowest_message_code, highest_message_code, status);
           IF NOT status.normal THEN
             RETURN;
           IFEND;

           IF message_module THEN
             dictionary_sizes.number_of_message_modules := dictionary_sizes.number_of_message_modules + 1;
           IFEND;

           IF help_module THEN
             dictionary_sizes.number_of_help_modules := dictionary_sizes.number_of_help_modules + 1;
           IFEND;
           current_segment_number := #SEGMENT (module_description^.message_module_header);
           current_offset := #OFFSET (module_description^.message_module_header);

         = occ$panel_module =
           dictionary_sizes.number_of_panels := dictionary_sizes.number_of_panels + 1;

         = occ$ppu_object_module =

{ No entry points

         CASEND;

       IFEND;


     PROCEND obtain_dictionary_sizes;
?? OLDTITLE ??
?? EJECT ??

{ The value for prestreaming_transfer_size is chosen with the understanding that
{ access to the library members is not quite sequential (in the typical case).
{ Access is from low address to high address, but oftentimes several pages are
{ skipped due to large modules.  Streaming is useful if the library contains
{ small modules, program descriptions, small SCL procedures or the like.
{ So, very little read ahead is done because it is unknown if the next module
{ is small or large.

     CONST
       prestreaming_transfer_size = 16384;

{ Indicates the number of library members that will be accessed before pages in
{ memory are flushed out of the working set.  This number should be chosen with
{ the understanding that each library member may cross a page boundary and thus
{ the number of pages in the working set may be double this value.

     CONST
       advise_out_limit = 50;

     TYPE
       dictionary_size_info = record
         number_of_modules: integer,
         number_of_entry_points: integer,
         number_of_commands: integer,
         number_of_functions: integer,
         number_of_help_modules: integer,
         number_of_message_modules: integer,
         number_of_panels: integer,
       recend;

     VAR
       advise_out_count: 0 .. advise_out_limit,
       current_offset: ost$segment_length,
       current_segment_number: ost$segment,
       last_offset: ost$segment_length,
       last_segment_number: ost$segment,
       page_size: ost$page_size,
       save_free_behind: boolean,
       save_transfer_size: 0 .. 15,
       ignore_status: ost$status,
       pva_p: ^cell,

       load_module: ^oct$load_module_list,

       number_of_dictionaries: 0 .. llc$max_dictionaries_on_library,
       i: 0 .. llc$max_dictionaries_on_library,
       dictionary_sizes: dictionary_size_info,

       object_library_header: ^llt$object_library_header,
       object_library_dictionaries: ^llt$object_library_dictionaries;

     number_of_dictionaries := 0;
     dictionary_sizes.number_of_modules := 0;
     dictionary_sizes.number_of_entry_points := 0;
     dictionary_sizes.number_of_commands := 0;
     dictionary_sizes.number_of_functions := 0;
     dictionary_sizes.number_of_help_modules := 0;
     dictionary_sizes.number_of_message_modules := 0;
     dictionary_sizes.number_of_panels := 0;

     load_module := load_module_list.link;

     last_segment_number := 0;
     current_segment_number := 0;
     pva_p := ^current_segment_number;

     pmp$get_page_size (page_size, ignore_status);
     current_offset := 0;
     last_offset := 0;
     advise_out_count := 0;

     REPEAT

{ IMPORTANT:
{   The procedure obtain_dictionary_sizes changes the values of the variables
{   current_segment_number and current_offset.

{ If the segment number has changed, reset the segment attributes on the old
{ segment to what they were and set the segment attributes on the new segment
{ for sequential access and free-behind.  The expected case is for the name
{ list to be ordered for sequential access on a file.  This happens if ADDM is
{ called with just a library or a library and a range of module names.  These
{ are two of the three typical cases.  The third case is an ADDM of just one
{ or two modules.  Additional overhead will occur in this case, but typically
{ only once per file.  A very degenerative case would be for a library to be in
{ reverse alphabetical order and then have ADDM requests done in alphabetical
{ order.  This would cause access to the segment to be backwards, so free behind
{ and sequential access would be ignored.  This case is not typical, so it will
{ be ignored.

       IF current_segment_number <> last_segment_number THEN
         IF last_segment_number <> 0 THEN
           pva_p := #ADDRESS (#RING (pva_p), last_segment_number, 0);
           mmp$preset_page_streaming ({preset_and_save_ts_fb} FALSE, pva_p, prestreaming_transfer_size,
                 save_transfer_size, save_free_behind, status);
           IF NOT status.normal THEN
             RETURN;
           IFEND;
         IFEND;
         pva_p := #ADDRESS (#RING (pva_p), current_segment_number, 0);
         mmp$preset_page_streaming ({preset_and_save_ts_fb} TRUE, pva_p, prestreaming_transfer_size,
               save_transfer_size, save_free_behind, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;
         last_segment_number := current_segment_number;

{ Let page and cyclic aging remove the pages from the working set.  True sequential
{ access has not been achieved.

         current_offset := (current_offset DIV page_size) * page_size;
         last_offset := current_offset;
         advise_out_count := 0;
       IFEND;

{ Free-behind only works well if the pages in the file are accessed sequentially
{ one after the other, without skipping pages.  Since this is not the case here,
{ memory management must be notified that pages must be removed from the working
{ set.  After examining the module headers for advise_out_limit modules, the pages
{ between the last saved segment offset and the current offset (minus one) are
{ forced out of the working set by call mmp$advise_out.  This significantly
{ reduces the cost of aging the working set.

       IF advise_out_count = advise_out_limit THEN

{ Round down to nearest page size.

         current_offset := (current_offset DIV page_size) * page_size;
         IF last_offset < current_offset THEN
           pva_p := #ADDRESS (#RING (pva_p), current_segment_number, last_offset);
           mmp$advise_out (pva_p, current_offset - last_offset, status);
           IF NOT status.normal THEN
             RETURN;
           IFEND;
           last_offset := current_offset;
         IFEND;
         advise_out_count := 0;
       ELSE
         advise_out_count := advise_out_count + 1;
       IFEND;

       dictionary_sizes.number_of_modules := dictionary_sizes.number_of_modules + 1;

       obtain_dictionary_sizes (load_module^.description, load_module^.changed_info, dictionary_sizes,
             status);
       IF NOT status.normal THEN
         RETURN;
       IFEND;

       load_module := load_module^.link;

     UNTIL load_module = NIL;

     IF last_segment_number <> 0 THEN
       pva_p := #ADDRESS (#RING (pva_p), last_segment_number, 0);
       mmp$preset_page_streaming ({preset_and_save_ts_fb} FALSE, pva_p, prestreaming_transfer_size,
             save_transfer_size, save_free_behind, status);
       IF NOT status.normal THEN
         RETURN;
       IFEND;
     IFEND;

     IF dictionary_sizes.number_of_modules > 0 THEN
       number_of_dictionaries := number_of_dictionaries + 1;
     IFEND;

     IF dictionary_sizes.number_of_entry_points > 0 THEN
       number_of_dictionaries := number_of_dictionaries + 1;
     IFEND;

     IF dictionary_sizes.number_of_commands > 0 THEN
       number_of_dictionaries := number_of_dictionaries + 1;
     IFEND;

     IF dictionary_sizes.number_of_functions > 0 THEN
       number_of_dictionaries := number_of_dictionaries + 1;
     IFEND;

     IF dictionary_sizes.number_of_help_modules > 0 THEN
       number_of_dictionaries := number_of_dictionaries + 1;
     IFEND;

     IF dictionary_sizes.number_of_message_modules > 0 THEN
       number_of_dictionaries := number_of_dictionaries + 1;
     IFEND;

     IF dictionary_sizes.number_of_panels > 0 THEN
       number_of_dictionaries := number_of_dictionaries + 1;
     IFEND;

     NEXT object_library_header IN new_library;
     IF object_library_header = NIL THEN
       osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
       RETURN;
     IFEND;

     object_library_header^.version := llc$object_library_version;
     object_library_header^.number_of_dictionaries := number_of_dictionaries;

     NEXT object_library_dictionaries: [1 .. number_of_dictionaries] IN new_library;
     IF object_library_dictionaries = NIL THEN
       osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
       RETURN;
     IFEND;

     i := 1;

     IF dictionary_sizes.number_of_modules > 0 THEN
       IF dictionary_sizes.number_of_modules > llc$max_modules_in_library THEN
         osp$set_status_abnormal (oc, oce$e_too_many_modules_on_lib, '', status);
         RETURN;
       IFEND;
       NEXT module_dictionary: [1 .. dictionary_sizes.number_of_modules] IN new_library;
       IF module_dictionary = NIL THEN
         osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
         RETURN;
       IFEND;
       object_library_dictionaries^ [i].kind := llc$module_dictionary;
       object_library_dictionaries^ [i].module_dictionary := #REL (module_dictionary, new_library^);
       i := i + 1;
     ELSE
       module_dictionary := NIL;
     IFEND;

     IF dictionary_sizes.number_of_entry_points > 0 THEN
       IF dictionary_sizes.number_of_entry_points > llc$max_entry_points_in_library THEN
         osp$set_status_abnormal (oc, oce$e_too_many_entry_points, '', status);
         RETURN;
       IFEND;
       NEXT entry_point_dictionary: [1 .. dictionary_sizes.number_of_entry_points] IN new_library;
       IF entry_point_dictionary = NIL THEN
         osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
         RETURN;
       IFEND;
       object_library_dictionaries^ [i].kind := llc$entry_point_dictionary;
       object_library_dictionaries^ [i].entry_point_dictionary := #REL (entry_point_dictionary, new_library^);
       i := i + 1;
     ELSE
       entry_point_dictionary := NIL;
     IFEND;

     IF dictionary_sizes.number_of_commands > 0 THEN
       IF dictionary_sizes.number_of_commands > llc$max_commands_in_library THEN
         osp$set_status_abnormal (oc, oce$e_too_many_commands_on_lib, '', status);
         RETURN;
       IFEND;
       NEXT command_dictionary: [1 .. dictionary_sizes.number_of_commands] IN new_library;
       IF command_dictionary = NIL THEN
         osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
         RETURN;
       IFEND;
       object_library_dictionaries^ [i].kind := llc$command_dictionary;
       object_library_dictionaries^ [i].command_dictionary := #REL (command_dictionary, new_library^);
       i := i + 1;
     ELSE
       command_dictionary := NIL;
     IFEND;

     IF dictionary_sizes.number_of_functions > 0 THEN
       IF dictionary_sizes.number_of_functions > llc$max_functions_in_library THEN
         osp$set_status_abnormal (oc, oce$e_too_many_functions_on_lib, '', status);
         RETURN;
       IFEND;
       NEXT function_dictionary: [1 .. dictionary_sizes.number_of_functions] IN new_library;
       IF function_dictionary = NIL THEN
         osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
         RETURN;
       IFEND;
       object_library_dictionaries^ [i].kind := llc$function_dictionary;
       object_library_dictionaries^ [i].function_dictionary := #REL (function_dictionary, new_library^);
       i := i + 1;
     ELSE
       function_dictionary := NIL;
     IFEND;

     IF dictionary_sizes.number_of_help_modules > 0 THEN
       IF dictionary_sizes.number_of_help_modules > llc$max_help_modules_in_library THEN
         osp$set_status_abnormal (oc, oce$e_too_many_help_mods_on_lib, '', status);
         RETURN;
       IFEND;
       NEXT help_module_dictionary: [1 .. dictionary_sizes.number_of_help_modules] IN new_library;
       IF help_module_dictionary = NIL THEN
         osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
         RETURN;
       IFEND;
       object_library_dictionaries^ [i].kind := llc$help_module_dictionary;
       object_library_dictionaries^ [i].help_module_dictionary := #REL (help_module_dictionary, new_library^);
       i := i + 1;
     ELSE
       help_module_dictionary := NIL;
     IFEND;

     IF dictionary_sizes.number_of_message_modules > 0 THEN
       IF dictionary_sizes.number_of_message_modules > llc$max_message_modules_in_lib THEN
         osp$set_status_abnormal (oc, oce$e_too_many_msg_mods_on_lib, '', status);
         RETURN;
       IFEND;
       NEXT message_module_dictionary: [1 .. dictionary_sizes.number_of_message_modules] IN new_library;
       IF message_module_dictionary = NIL THEN
         osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
         RETURN;
       IFEND;
       object_library_dictionaries^ [i].kind := llc$message_module_dictionary;
       object_library_dictionaries^ [i].message_module_dictionary :=
             #REL (message_module_dictionary, new_library^);
       i := i + 1;
     ELSE
       message_module_dictionary := NIL;
     IFEND;

     IF dictionary_sizes.number_of_panels > 0 THEN
       IF dictionary_sizes.number_of_panels > llc$max_panels_in_library THEN
         osp$set_status_abnormal (oc, oce$e_too_many_panels_on_lib, '', status);
         RETURN;
       IFEND;
       NEXT panel_dictionary: [1 .. dictionary_sizes.number_of_panels] IN new_library;
       IF panel_dictionary = NIL THEN
         osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
         RETURN;
       IFEND;
       object_library_dictionaries^ [i].kind := llc$panel_dictionary;
       object_library_dictionaries^ [i].panel_dictionary := #REL (panel_dictionary, new_library^);
     ELSE
       panel_dictionary := NIL;
     IFEND;

   PROCEND write_header_and_dictionaries;
?? OLDTITLE ??
?? NEWTITLE := '          COMPUTE_SECTION_LENGTH' ??
?? EJECT ??

   PROCEDURE compute_section_length
     (    for_code_sections: boolean;
          load_module_list: oct$load_module_list;
      VAR temporary_library: ^SEQ ( * );
      VAR section_length: ost$segment_length;
      VAR status: ost$status);

?? NEWTITLE := '            ADD_TO_SECTION_LENGTH' ??
?? EJECT ??

     PROCEDURE add_to_section_length
       (    allocation_alignment: ost$segment_offset;
            allocation_offset: ost$segment_offset;
            section_length: ost$segment_length;
        VAR offset: ost$segment_length);



       WHILE allocation_offset <> (offset MOD allocation_alignment) DO
         offset := offset + 1;
       WHILEND;

       offset := offset + section_length;


     PROCEND add_to_section_length;
?? OLDTITLE ??
?? NEWTITLE := '            COMPUTE_LOAD_MODULE_SEC_LENGTH' ??
?? EJECT ??

     PROCEDURE compute_load_module_sec_length
       (    for_code_sections: boolean;
            description: ^oct$module_description;
        VAR section_length: ost$segment_length;
        VAR status: ost$status);



       VAR
         section_definition: ^llt$section_definition,
         segment_definition: ^llt$segment_definition,
         obsolete_segment_definition: ^llt$obsolete_segment_definition,

         load_module_header: ^llt$load_module_header,

         object_text_descriptor: ^llt$object_text_descriptor,
         length: ost$segment_length;


       IF (llc$section_element IN description^.load_module_header^.interpretive_header.elements_defined) THEN

         object_text_descriptor := #PTR (description^.load_module_header^.interpretive_header.
               section_definitions, description^.file^);
         IF object_text_descriptor = NIL THEN
           osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, description^.name, status);
           RETURN;
         IFEND;

         RESET description^.file TO object_text_descriptor;
         NEXT object_text_descriptor IN description^.file;

         WHILE (object_text_descriptor^.kind = llc$segment_definition) OR
               (object_text_descriptor^.kind = llc$allotted_segment_definition) DO

           NEXT segment_definition IN description^.file;
           IF segment_definition = NIL THEN
             osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, description^.name, status);
             RETURN;
           IFEND;

           IF object_text_descriptor^.kind = llc$allotted_segment_definition THEN
             section_definition := ^segment_definition^.section_definition;

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

             IF length <> 0 THEN
               IF ((for_code_sections) AND (section_definition^.kind = llc$code_section)) OR
                     ((NOT for_code_sections) AND (section_definition^.kind <> llc$code_section)) THEN
                 add_to_section_length (section_definition^.allocation_alignment,
                       section_definition^.allocation_offset, length, section_length);
               IFEND;
             IFEND;
           IFEND;

           NEXT object_text_descriptor IN description^.file;
           IF object_text_descriptor = NIL THEN
             osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, description^.name, status);
             RETURN;
           IFEND;

         WHILEND;

         WHILE (object_text_descriptor^.kind = llc$obsolete_segment_definition) OR
               (object_text_descriptor^.kind = llc$obsolete_allotted_seg_def) DO

           NEXT obsolete_segment_definition IN description^.file;
           IF obsolete_segment_definition = NIL THEN
             osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, description^.name, status);
             RETURN;
           IFEND;

           IF object_text_descriptor^.kind = llc$obsolete_allotted_seg_def THEN
             section_definition := ^obsolete_segment_definition^.section_definition;

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

             IF length <> 0 THEN
               IF ((for_code_sections) AND (section_definition^.kind = llc$code_section)) OR
                     ((NOT for_code_sections) AND (section_definition^.kind <> llc$code_section)) THEN
                 add_to_section_length (section_definition^.allocation_alignment,
                       section_definition^.allocation_offset, length, section_length);
               IFEND;
             IFEND;
           IFEND;

           NEXT object_text_descriptor IN description^.file;
           IF object_text_descriptor = NIL THEN
             osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, description^.name, status);
             RETURN;
           IFEND;

         WHILEND;

         WHILE (object_text_descriptor^.kind = llc$section_definition) OR
               (object_text_descriptor^.kind = llc$allotted_section_definition) OR
               (object_text_descriptor^.kind = llc$unallocated_common_block) DO
           NEXT section_definition IN description^.file;
           IF section_definition = NIL THEN
             osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, description^.name, status);
             RETURN;
           IFEND;

           IF object_text_descriptor^.kind = llc$allotted_section_definition THEN
             IF section_definition^.length <> 0 THEN
               IF ((for_code_sections) AND (section_definition^.kind = llc$code_section)) OR
                     ((NOT for_code_sections) AND (section_definition^.kind <> llc$code_section)) THEN
                 add_to_section_length (section_definition^.allocation_alignment,
                       section_definition^.allocation_offset, section_definition^.length, section_length);
               IFEND;
             IFEND;
           IFEND;

           NEXT object_text_descriptor IN description^.file;
           IF object_text_descriptor = NIL THEN
             osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, description^.name, status);
             RETURN;
           IFEND;

         WHILEND;
       IFEND;


     PROCEND compute_load_module_sec_length;
?? OLDTITLE ??
?? NEWTITLE := '            WRITE_TEMP_MODULE_CODE_SECTION' ??
?? EJECT ??

     PROCEDURE compute_temp_module_sec_length
       (    for_code_sections: boolean;
            description: ^oct$module_description;
        VAR section_length: ost$segment_length;
        VAR status: ost$status);


       VAR
         section_definition: llt$section_definition,
         section_definitions: ^oct$section_definition_list,
         length: ost$segment_length;


       section_definitions := description^.temporary_module_header^.section_definitions.link;

       WHILE section_definitions <> NIL DO
         IF section_definitions^.allotted_section THEN
           section_definition := section_definitions^.section_definition;

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

           IF length <> 0 THEN
             IF ((for_code_sections) AND (section_definition.kind = llc$code_section)) OR
                   ((NOT for_code_sections) AND (section_definition.kind <> llc$code_section)) THEN
               add_to_section_length (section_definition.allocation_alignment,
                     section_definition.allocation_offset, length, section_length);
             IFEND;
           IFEND;
         IFEND;

         section_definitions := section_definitions^.link;
       WHILEND;



     PROCEND compute_temp_module_sec_length;
?? OLDTITLE ??
?? EJECT ??


     VAR
       seq_pointer: ost$segment_length,
       offset: ost$segment_length,
       load_module: ^oct$load_module_list;


     offset := i#current_sequence_position (temporary_library);
     seq_pointer := offset;


     load_module := load_module_list.link;

     REPEAT

       CASE load_module^.description^.kind OF
       = occ$ppu_object_module, occ$program_description, occ$command_procedure, occ$function_procedure,
             occ$message_module, occ$panel_module, occ$applic_program_description,
             occ$applic_command_procedure, occ$applic_command_description, occ$command_description,
             occ$function_description =

{ N/A

       = occ$load_module =
         compute_load_module_sec_length (for_code_sections, load_module^.description, offset, status);

       = occ$temporary_load_module =
         compute_temp_module_sec_length (for_code_sections, load_module^.description, offset, status);

       CASEND;

       load_module := load_module^.link;

     UNTIL load_module = NIL;


     section_length := offset - seq_pointer;


   PROCEND compute_section_length;
?? OLDTITLE ??
?? NEWTITLE := '          WRITE_HEADER_INTERPRETIVE_INFO' ??
?? EJECT ??

   PROCEDURE write_header_interpretive_info
     (    load_module_list: oct$load_module_list;
      VAR temporary_library: ^SEQ ( * );
      VAR module_dictionary: ^llt$module_dictionary;
      VAR entry_point_dictionary: ^llt$entry_point_dictionary;
      VAR command_dictionary: ^llt$command_dictionary;
      VAR function_dictionary: ^llt$function_dictionary;
      VAR help_module_dictionary: ^llt$help_module_dictionary;
      VAR message_module_dictionary: ^llt$message_module_dictionary;
      VAR panel_dictionary: ^llt$panel_dictionary;
      VAR code_section: ^cell;
      VAR read_section: ^cell;
      VAR status: ost$status);

?? NEWTITLE := '            ADD_TO_ENTRY_POINT_DICTIONARY' ??
?? EJECT ??

     PROCEDURE add_to_entry_point_dictionary
       (    module_dictionary_item: llt$module_dictionary_item;
            temporary_library: ^SEQ ( * );
        VAR next_entry_point: llt$entry_point_index;
        VAR entry_point_dictionary: ^llt$entry_point_dictionary);

?? NEWTITLE := '              ADD_ENTRY_POINT', EJECT ??

       PROCEDURE add_entry_point
         (    entry_point_item: llt$entry_point_dictionary_item);


         VAR
           entry_point_found: boolean,
           hi: llt$entry_point_index,
           i: llt$entry_point_index,
           insert: llt$entry_point_index,
           lo: llt$entry_point_index,
           local_status: ost$status,
           temp: integer,
           mid: llt$entry_point_index;

         hi := next_entry_point;
         entry_point_found := FALSE;
         lo := 1;

         WHILE (lo <= hi) AND NOT entry_point_found DO
           temp := lo + hi;
           mid := temp DIV 2;
           IF entry_point_item.name = entry_point_dictionary^ [mid].name THEN
             entry_point_found := TRUE;
           ELSEIF entry_point_item.name < entry_point_dictionary^ [mid].name THEN
             hi := mid - 1;
           ELSE
             lo := mid + 1;
           IFEND;
         WHILEND;

         IF entry_point_found THEN
           insert := mid;
         ELSE
           insert := lo;
         IFEND;

         IF entry_point_found AND ((entry_point_dictionary^ [insert].module_kind <> llc$load_module) OR
               (entry_point_item.module_kind <> llc$load_module)) THEN
           osp$set_status_abnormal (oc, oce$w_dup_ent_pnt_on_lib, entry_point_item.name, local_status);
           ocp$generate_message (local_status);
           osp$set_status_abnormal (oc, oce$w_non_fatal_generate_error, '', command_status);
         IFEND;

         next_entry_point := next_entry_point + 1;

         FOR i := (next_entry_point - 1) DOWNTO insert DO
           entry_point_dictionary^ [i + 1] := entry_point_dictionary^ [i];
         FOREND;

         entry_point_dictionary^ [insert] := entry_point_item;

       PROCEND add_entry_point;
?? OLDTITLE ??
?? EJECT ??


       VAR
         library: ^SEQ ( * ),

         load_module_header: ^llt$load_module_header,
         object_text_descriptor: ^llt$object_text_descriptor,
         entry_definition: ^llt$entry_definition,
         entry_point_item: llt$entry_point_dictionary_item;


       library := temporary_library;

       load_module_header := #PTR (module_dictionary_item.module_header, library^);

       IF llc$entry_point_element IN load_module_header^.interpretive_header.elements_defined THEN
         object_text_descriptor := #PTR (load_module_header^.interpretive_header.entry_points, library^);

         RESET library TO object_text_descriptor;
         NEXT object_text_descriptor IN library;

         IF object_text_descriptor^.kind = llc$entry_definition THEN
           REPEAT
             NEXT entry_definition IN library;

             entry_point_item.name := entry_definition^.name;

             IF llc$gated_entry_point IN entry_definition^.attributes THEN
               entry_point_item.kind := llc$gate;
             ELSE
               entry_point_item.kind := llc$entry_point;
             IFEND;

             entry_point_item.module_kind := llc$load_module;
             entry_point_item.module_header := module_dictionary_item.module_header;
             add_entry_point (entry_point_item);

             NEXT object_text_descriptor IN library;

           UNTIL object_text_descriptor^.kind <> llc$entry_definition;
         IFEND;
       IFEND;


     PROCEND add_to_entry_point_dictionary;
?? OLDTITLE ??
?? NEWTITLE := '            ADD_TO_COMMAND_DICTIONARY' ??
?? EJECT ??

     PROCEDURE add_to_command_dictionary
       (    module_dictionary_item: llt$module_dictionary_item;
            temporary_library: ^SEQ ( * );
        VAR next_command: llt$command_index;
        VAR command_dictionary: ^llt$command_dictionary);

?? NEWTITLE := '              ADD_COMMAND', EJECT ??

       PROCEDURE add_command
         (    command_item: llt$command_dictionary_item);


         VAR
           i: llt$command_index,
           local_status: ost$status;


         FOR i := 1 TO next_command DO
           IF command_dictionary^ [i].name = command_item.name THEN
             IF (command_dictionary^ [i].module_kind <> llc$load_module) OR
                   (command_item.module_kind <> llc$load_module) THEN
               osp$set_status_abnormal (oc, oce$w_dup_commands_on_lib, command_item.name, local_status);
               ocp$generate_message (local_status);
               osp$set_status_abnormal (oc, oce$w_non_fatal_generate_error, '', command_status);
             IFEND;
           IFEND;
         FOREND;


         next_command := next_command + 1;

         command_dictionary^ [next_command] := command_item;


       PROCEND add_command;
?? OLDTITLE ??
?? EJECT ??


       VAR
         library: ^SEQ ( * ),

         application_member_header: ^llt$application_member_header,
         library_member_header: ^llt$library_member_header,
         alias_list: ^pmt$module_list,
         i: llt$number_of_aliases,
         entry_definition: ^llt$entry_definition,
         load_module_header: ^llt$load_module_header,
         transfer_symbol: ^llt$transfer_symbol,
         object_text_descriptor: ^llt$object_text_descriptor,
         command_item: llt$command_dictionary_item;


       library := temporary_library;

       CASE module_dictionary_item.kind OF

       = llc$load_module =

         load_module_header := #PTR (module_dictionary_item.module_header, library^);

         IF (llc$interpretive_element IN load_module_header^.elements_defined) AND
               (llc$transfer_symbol_element IN load_module_header^.interpretive_header.elements_defined) THEN

           object_text_descriptor := #PTR (load_module_header^.interpretive_header.transfer_symbol, library^);
           IF object_text_descriptor = NIL THEN
             osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, '', status);
             RETURN;
           IFEND;

           RESET library TO object_text_descriptor;
           NEXT object_text_descriptor IN library;
           NEXT transfer_symbol IN library;
           IF transfer_symbol^.name <> osc$null_name THEN

{ Find the entry point definition record for the transfer symbol.

             IF llc$entry_point_element IN load_module_header^.interpretive_header.elements_defined THEN
               object_text_descriptor := #PTR (load_module_header^.interpretive_header.entry_points,
                     library^);
               RESET library TO object_text_descriptor;
               NEXT object_text_descriptor IN library;

{ If object_text_descriptor or entry_definition is NIL, we would have discovered it earlier.

             /find_entry_point/
               BEGIN
                 REPEAT
                   NEXT entry_definition IN library;
                   IF entry_definition^.name = transfer_symbol^.name THEN
                     IF llc$gated_entry_point IN entry_definition^.attributes THEN
                       command_item.kind := llc$gate;
                     ELSE
                       command_item.kind := llc$entry_point;
                     IFEND;
                     EXIT /find_entry_point/;
                   IFEND;
                   NEXT object_text_descriptor IN library;
                 UNTIL object_text_descriptor^.kind <> llc$entry_definition;

{ We didn't find an entry point record to match the transfer symbol; could be an error,
{ could be C code.  Assume the worst, that it's C.

                 command_item.kind := llc$entry_point;
               END /find_entry_point/;
             ELSE

{ No entry point element was found. Again, this could be an error or it could be C.

               command_item.kind := llc$entry_point;

             IFEND;

             command_item.name := transfer_symbol^.name;
             command_item.class := clc$nominal_entry;
             command_item.availability := clc$advertised_entry;
             command_item.ordinal := load_module_header^.module_index;
             command_item.log_option := clc$automatically_log;
             command_item.module_kind := llc$load_module;
             command_item.module_header := module_dictionary_item.module_header;

             add_command (command_item);

           IFEND;

         IFEND;

       = llc$program_description =

         library_member_header := #PTR (module_dictionary_item.program_header, library^);

         command_item.name := module_dictionary_item.name;
         command_item.class := clc$nominal_entry;
         command_item.availability := library_member_header^.command_function_availability;
         command_item.ordinal := library_member_header^.module_index;
         command_item.kind := library_member_header^.command_function_kind;
         command_item.log_option := library_member_header^.command_log_option;
         command_item.module_kind := llc$program_description;
         command_item.program_header := module_dictionary_item.program_header;

         add_command (command_item);

         IF library_member_header^.number_of_aliases <> 0 THEN
           alias_list := #PTR (library_member_header^.aliases, library^);
           FOR i := 1 TO library_member_header^.number_of_aliases DO
             command_item.name := alias_list^ [i];
             IF i = library_member_header^.number_of_aliases THEN
               command_item.class := clc$abbreviation_entry;
             ELSE
               command_item.class := clc$alias_entry;
             IFEND;
             add_command (command_item);
           FOREND;
         IFEND;

       = llc$command_procedure =

         library_member_header := #PTR (module_dictionary_item.command_header, library^);

         command_item.name := module_dictionary_item.name;
         command_item.class := clc$nominal_entry;
         command_item.availability := library_member_header^.command_function_availability;
         command_item.ordinal := library_member_header^.module_index;
         command_item.kind := library_member_header^.command_function_kind;
         command_item.log_option := library_member_header^.command_log_option;
         command_item.module_kind := llc$command_procedure;
         command_item.command_header := module_dictionary_item.command_header;

         add_command (command_item);

         IF library_member_header^.number_of_aliases <> 0 THEN
           alias_list := #PTR (library_member_header^.aliases, library^);
           FOR i := 1 TO library_member_header^.number_of_aliases DO
             command_item.name := alias_list^ [i];
             IF i = library_member_header^.number_of_aliases THEN
               command_item.class := clc$abbreviation_entry;
             ELSE
               command_item.class := clc$alias_entry;
             IFEND;
             add_command (command_item);
           FOREND;
         IFEND;

       = llc$command_description =

         library_member_header := #PTR (module_dictionary_item.command_description_header, library^);

         command_item.name := module_dictionary_item.name;
         command_item.class := clc$nominal_entry;
         command_item.availability := library_member_header^.command_function_availability;
         command_item.ordinal := library_member_header^.module_index;
         command_item.kind := library_member_header^.command_function_kind;
         command_item.log_option := library_member_header^.command_log_option;
         command_item.module_kind := llc$command_description;
         command_item.command_description_header := module_dictionary_item.command_description_header;

         add_command (command_item);

         IF library_member_header^.number_of_aliases <> 0 THEN
           alias_list := #PTR (library_member_header^.aliases, library^);
           FOR i := 1 TO library_member_header^.number_of_aliases DO
             command_item.name := alias_list^ [i];
             IF i = library_member_header^.number_of_aliases THEN
               command_item.class := clc$abbreviation_entry;
             ELSE
               command_item.class := clc$alias_entry;
             IFEND;
             add_command (command_item);
           FOREND;
         IFEND;

       = llc$applic_program_description =

         application_member_header := #PTR (module_dictionary_item.applic_program_header, library^);

         command_item.name := module_dictionary_item.name;
         command_item.class := clc$nominal_entry;
         command_item.availability := application_member_header^.library_member_header.
               command_function_availability;
         command_item.ordinal := application_member_header^.library_member_header.module_index;
         command_item.kind := application_member_header^.library_member_header.command_function_kind;
         command_item.log_option := application_member_header^.library_member_header.command_log_option;
         command_item.module_kind := llc$applic_program_description;
         command_item.program_header := module_dictionary_item.applic_program_header;

         add_command (command_item);

         IF application_member_header^.library_member_header.number_of_aliases <> 0 THEN
           alias_list := #PTR (application_member_header^.library_member_header.aliases, library^);
           FOR i := 1 TO application_member_header^.library_member_header.number_of_aliases DO
             command_item.name := alias_list^ [i];
             IF i = application_member_header^.library_member_header.number_of_aliases THEN
               command_item.class := clc$abbreviation_entry;
             ELSE
               command_item.class := clc$alias_entry;
             IFEND;
             add_command (command_item);
           FOREND;
         IFEND;

       = llc$applic_command_procedure =

         application_member_header := #PTR (module_dictionary_item.applic_command_header, library^);

         command_item.name := module_dictionary_item.name;
         command_item.class := clc$nominal_entry;
         command_item.availability := application_member_header^.library_member_header.
               command_function_availability;
         command_item.ordinal := application_member_header^.library_member_header.module_index;
         command_item.kind := application_member_header^.library_member_header.command_function_kind;
         command_item.log_option := application_member_header^.library_member_header.command_log_option;
         command_item.module_kind := llc$applic_command_procedure;
         command_item.command_header := module_dictionary_item.applic_command_header;

         add_command (command_item);

         IF application_member_header^.library_member_header.number_of_aliases <> 0 THEN
           alias_list := #PTR (application_member_header^.library_member_header.aliases, library^);
           FOR i := 1 TO application_member_header^.library_member_header.number_of_aliases DO
             command_item.name := alias_list^ [i];
             IF i = application_member_header^.library_member_header.number_of_aliases THEN
               command_item.class := clc$abbreviation_entry;
             ELSE
               command_item.class := clc$alias_entry;
             IFEND;
             add_command (command_item);
           FOREND;
         IFEND;

       = llc$applic_command_description =

         application_member_header := #PTR (module_dictionary_item.applic_command_description_hdr, library^);

         command_item.name := module_dictionary_item.name;
         command_item.class := clc$nominal_entry;
         command_item.availability := application_member_header^.library_member_header.
               command_function_availability;
         command_item.ordinal := application_member_header^.library_member_header.module_index;
         command_item.kind := application_member_header^.library_member_header.command_function_kind;
         command_item.log_option := application_member_header^.library_member_header.command_log_option;
         command_item.module_kind := llc$applic_command_description;
         command_item.command_description_header := module_dictionary_item.applic_command_description_hdr;

         add_command (command_item);

         IF application_member_header^.library_member_header.number_of_aliases <> 0 THEN
           alias_list := #PTR (application_member_header^.library_member_header.aliases, library^);
           FOR i := 1 TO application_member_header^.library_member_header.number_of_aliases DO
             command_item.name := alias_list^ [i];
             IF i = application_member_header^.library_member_header.number_of_aliases THEN
               command_item.class := clc$abbreviation_entry;
             ELSE
               command_item.class := clc$alias_entry;
             IFEND;
             add_command (command_item);
           FOREND;
         IFEND;

       CASEND;


     PROCEND add_to_command_dictionary;
?? OLDTITLE ??
?? NEWTITLE := '            ADD_TO_FUNCTION_DICTIONARY' ??
?? EJECT ??

     PROCEDURE add_to_function_dictionary
       (    module_dictionary_item: llt$module_dictionary_item;
            temporary_library: ^SEQ ( * );
        VAR next_function: llt$function_index;
        VAR function_dictionary: ^llt$function_dictionary);

?? NEWTITLE := '              ADD_FUNCTION', EJECT ??

       PROCEDURE add_function
         (    function_item: llt$function_dictionary_item);


         VAR
           i: llt$function_index,
           local_status: ost$status;


         FOR i := 1 TO next_function DO
           IF function_dictionary^ [i].name = function_item.name THEN
             osp$set_status_abnormal (oc, oce$w_dup_functions_on_lib, function_item.name, local_status);
             ocp$generate_message (local_status);
             osp$set_status_abnormal (oc, oce$w_non_fatal_generate_error, '', command_status);
           IFEND;
         FOREND;


         next_function := next_function + 1;

         function_dictionary^ [next_function] := function_item;


       PROCEND add_function;
?? OLDTITLE ??
?? EJECT ??


       VAR
         library: ^SEQ ( * ),

         library_member_header: ^llt$library_member_header,
         alias_list: ^pmt$module_list,
         i: llt$number_of_aliases,

         function_item: llt$function_dictionary_item;


       library := temporary_library;

       CASE module_dictionary_item.kind OF

       = llc$function_procedure =
         library_member_header := #PTR (module_dictionary_item.function_header, library^);

         function_item.name := module_dictionary_item.name;
         function_item.class := clc$nominal_entry;
         function_item.availability := library_member_header^.command_function_availability;
         function_item.ordinal := library_member_header^.module_index;
         function_item.kind := library_member_header^.command_function_kind;
         function_item.module_kind := llc$function_procedure;
         function_item.function_header := module_dictionary_item.function_header;

         add_function (function_item);

         IF library_member_header^.number_of_aliases <> 0 THEN
           alias_list := #PTR (library_member_header^.aliases, library^);
           FOR i := 1 TO library_member_header^.number_of_aliases DO
             function_item.name := alias_list^ [i];
             IF i = library_member_header^.number_of_aliases THEN
               function_item.class := clc$abbreviation_entry;
             ELSE
               function_item.class := clc$alias_entry;
             IFEND;
             add_function (function_item);
           FOREND;
         IFEND;

       = llc$function_description =
         library_member_header := #PTR (module_dictionary_item.function_description_header, library^);

         function_item.name := module_dictionary_item.name;
         function_item.class := clc$nominal_entry;
         function_item.availability := library_member_header^.command_function_availability;
         function_item.ordinal := library_member_header^.module_index;
         function_item.kind := library_member_header^.command_function_kind;
         function_item.module_kind := llc$function_description;
         function_item.function_description_header := module_dictionary_item.function_description_header;

         add_function (function_item);

         IF library_member_header^.number_of_aliases <> 0 THEN
           alias_list := #PTR (library_member_header^.aliases, library^);
           FOR i := 1 TO library_member_header^.number_of_aliases DO
             function_item.name := alias_list^ [i];
             IF i = library_member_header^.number_of_aliases THEN
               function_item.class := clc$abbreviation_entry;
             ELSE
               function_item.class := clc$alias_entry;
             IFEND;
             add_function (function_item);
           FOREND;
         IFEND;

       CASEND;

     PROCEND add_to_function_dictionary;
?? OLDTITLE ??
?? NEWTITLE := '            ADD_TO_MSG_AND_OR_MODULE_DICTS' ??
?? EJECT ??

     PROCEDURE add_to_msg_or_help_module_dicts
       (    module_dictionary_item: llt$module_dictionary_item;
            temporary_library: ^SEQ ( * );
        VAR next_help_module: llt$help_module_index;
        VAR next_message_module: llt$message_module_index;
        VAR message_module_dictionary: ^llt$message_module_dictionary);

?? NEWTITLE := '              ADD_HELP_MODULE', EJECT ??

       PROCEDURE add_help_module
         (    help_module_item: llt$help_module_dictionary_item);


         VAR
           i: llt$help_module_index,
           local_status: ost$status;


         FOR i := 1 TO next_help_module DO
           IF help_module_dictionary^ [i].name = help_module_item.name THEN
             osp$set_status_abnormal (oc, oce$w_dup_help_modules_on_lib, help_module_item.name, local_status);
             ocp$generate_message (local_status);
             osp$set_status_abnormal (oc, oce$w_non_fatal_generate_error, '', command_status);
           IFEND;
         FOREND;


         next_help_module := next_help_module + 1;

         help_module_dictionary^ [next_help_module] := help_module_item;


       PROCEND add_help_module;
?? OLDTITLE ??
?? NEWTITLE := '              ADD_MESSAGE_MODULE', EJECT ??

       PROCEDURE add_message_module
         (    message_module_item: llt$message_module_dict_item);


         VAR
           i: llt$message_module_index,
           local_status: ost$status;


         FOR i := 1 TO next_message_module DO
           IF message_module_dictionary^ [i].name = message_module_item.name THEN
             osp$set_status_abnormal (oc, oce$w_dup_msg_modules_on_lib, message_module_item.name,
                   local_status);
             ocp$generate_message (local_status);
             osp$set_status_abnormal (oc, oce$w_non_fatal_generate_error, '', command_status);
           IFEND;
         FOREND;


         next_message_module := next_message_module + 1;

         message_module_dictionary^ [next_message_module] := message_module_item;


       PROCEND add_message_module;
?? OLDTITLE ??
?? EJECT ??


       VAR
         library: ^SEQ ( * ),

         library_member_header: ^llt$library_member_header,
         message_template_module: ^ost$message_template_module,

         natural_language: ost$natural_language,
         online_manual_name: ost$online_manual_name,
         help_module: boolean,
         message_module: boolean,
         lowest_message_code: ost$status_condition_code,
         highest_message_code: ost$status_condition_code,

         message_module_item: llt$message_module_dict_item,
         help_module_item: llt$help_module_dictionary_item;


       library := temporary_library;

       library_member_header := #PTR (module_dictionary_item.message_header, library^);
       RESET library TO library_member_header;
       message_template_module := #PTR (library_member_header^.member, library^);

       RESET message_template_module;
       clp$get_message_module_info (message_template_module, natural_language, online_manual_name,
             help_module, message_module, lowest_message_code, highest_message_code, status);
       IF NOT status.normal THEN
         RETURN;
       IFEND;

       IF message_module THEN

         message_module_item.name := module_dictionary_item.name;
         message_module_item.language := natural_language;
         message_module_item.lowest_condition_code := lowest_message_code;
         message_module_item.highest_condition_code := highest_message_code;
         message_module_item.message_header := module_dictionary_item.message_header;

         add_message_module (message_module_item);

       IFEND;

       IF help_module THEN

         help_module_item.name := module_dictionary_item.name;
         help_module_item.language := natural_language;
         help_module_item.help_header := module_dictionary_item.message_header;

         add_help_module (help_module_item);

       IFEND;

     PROCEND add_to_msg_or_help_module_dicts;
?? OLDTITLE ??
?? NEWTITLE := '            ADD_TO_PANEL_DICTIONARY' ??
?? EJECT ??

     PROCEDURE add_to_panel_dictionary
       (    module_dictionary_item: llt$module_dictionary_item;
            temporary_library: ^SEQ ( * );
        VAR next_panel: llt$panel_index;
        VAR panel_dictionary: ^llt$panel_dictionary);

?? NEWTITLE := '              ADD_PANEL', EJECT ??

       PROCEDURE add_panel
         (    panel_item: llt$panel_dictionary_item);


         VAR
           i: llt$panel_index,
           local_status: ost$status;


         FOR i := 1 TO next_panel DO
           IF panel_dictionary^ [i].name = panel_item.name THEN
             osp$set_status_abnormal (oc, oce$w_dup_panels_on_lib, panel_item.name, local_status);
             ocp$generate_message (local_status);
             osp$set_status_abnormal (oc, oce$w_non_fatal_generate_error, '', command_status);
           IFEND;
         FOREND;


         next_panel := next_panel + 1;

         panel_dictionary^ [next_panel] := panel_item;


       PROCEND add_panel;
?? OLDTITLE ??
?? EJECT ??


       VAR
         library: ^SEQ ( * ),

         panel_item: llt$panel_dictionary_item;


       library := temporary_library;

       panel_item.name := module_dictionary_item.name;
       panel_item.panel_header := module_dictionary_item.panel_header;

       add_panel (panel_item);


     PROCEND add_to_panel_dictionary;
?? OLDTITLE ??
?? EJECT ??

{ The value for prestreaming_transfer_size is chosen for optimum performance.  The
{ library is accessed sequentially (typically) and thus prestreaming should read-ahead
{ as much data is as possible to keep the disk driver streaming.

     CONST
       prestreaming_transfer_size = 65536;

     VAR
       save_temp_transfer_size: 0 .. 15,
       save_temp_free_behind: boolean,
       save_transfer_size: 0 .. 15,
       save_free_behind: boolean,
       last_segment_number: ost$segment,
       current_segment_number: ost$segment,
       pva_p: ^cell,
       load_module_header: ^llt$load_module_header,
       ppu_header: ^llt$object_text_descriptor,
       program_header: ^llt$library_member_header,
       command_header: ^llt$library_member_header,
       command_description_header: ^llt$library_member_header,
       function_header: ^llt$library_member_header,
       function_description_header: ^llt$library_member_header,
       message_header: ^llt$library_member_header,
       panel_header: ^llt$library_member_header,
       applic_program_header: ^llt$application_member_header,
       applic_command_header: ^llt$application_member_header,
       applic_command_description_hdr: ^llt$application_member_header,

       module_index: llt$module_index,

       next_entry_point: llt$entry_point_index,
       next_command: llt$command_index,
       next_function: llt$function_index,
       next_message_module: llt$message_module_index,
       next_help_module: llt$help_module_index,
       next_panel: llt$panel_index,

       load_module: ^oct$load_module_list;

     module_index := 0;
     next_entry_point := 0;
     next_command := 0;
     next_function := 0;
     next_message_module := 0;
     next_help_module := 0;
     next_panel := 0;

     load_module := load_module_list.link;

     last_segment_number := 0;
     current_segment_number := 0;
     pva_p := ^current_segment_number;
     mmp$preset_page_streaming ({preset_and_save_ts_fb} TRUE, temporary_library, prestreaming_transfer_size,
           save_temp_transfer_size, save_temp_free_behind, status);
     IF NOT status.normal THEN
       RETURN;
     IFEND;

     REPEAT

{ If the segment number has changed, reset the segment attributes on the old
{ segment to what they were and set the segment attributes on the new segment
{ for sequential access and free-behind.  The expected case is for the name
{ list to be ordered for sequential access on a file.  This happens if ADDM is
{ called with just a library or a library and a range of module names.  These
{ are two of the three typical cases.  The third case is an ADDM of just one
{ or two modules.  Additional overhead will occur in this case, but typically
{ only once per file.  A very degenerative case would be for a library to be in
{ reverse alphabetical order and then have ADDM requests done in alphabetical
{ order.  This would cause access to the segment to be backwards, so free behind
{ and sequential access would be ignored.  This case is not typical, so it will
{ be ignored.

       IF current_segment_number <> last_segment_number THEN
         IF last_segment_number <> 0 THEN
           pva_p := #ADDRESS (#RING (pva_p), last_segment_number, 0);
           mmp$preset_page_streaming ({preset_and_save_ts_fb} FALSE, pva_p, prestreaming_transfer_size,
                 save_transfer_size, save_free_behind, status);
           IF NOT status.normal THEN
             RETURN;
           IFEND;
         IFEND;
         pva_p := #ADDRESS (#RING (pva_p), current_segment_number, 0);
         mmp$preset_page_streaming ({preset_and_save_ts_fb} TRUE, pva_p, prestreaming_transfer_size,
               save_transfer_size, save_free_behind, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;
         last_segment_number := current_segment_number;
       IFEND;
       module_index := module_index + 1;
       module_dictionary^ [module_index].name := load_module^.name;
       IF load_module^.description^.file <> NIL THEN
         current_segment_number := #SEGMENT (load_module^.description^.file);
       IFEND;

       CASE load_module^.description^.kind OF
       = occ$ppu_object_module =
         module_dictionary^ [module_index].kind := llc$ppu_object_module;

         copy_ppu_object_module (load_module^.description, load_module^.changed_info, ppu_header,
               temporary_library, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;

         module_dictionary^ [module_index].ppu_header := #REL (ppu_header, temporary_library^);

       = occ$load_module =
         module_dictionary^ [module_index].kind := llc$load_module;

         copy_load_module (module_index, load_module^.description, load_module^.changed_info,
               load_module_header, code_section, read_section, temporary_library, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;

         module_dictionary^ [module_index].module_header := #REL (load_module_header, temporary_library^);

         add_to_entry_point_dictionary (module_dictionary^ [module_index], temporary_library,
               next_entry_point, entry_point_dictionary);

         add_to_command_dictionary (module_dictionary^ [module_index], temporary_library, next_command,
               command_dictionary);

       = occ$program_description =
         IF (load_module^.changed_info <> NIL) AND (load_module^.changed_info^.application_identifier <>
               NIL) AND (load_module^.changed_info^.application_identifier^.name <> osc$null_name) THEN
           module_dictionary^ [module_index].kind := llc$applic_program_description;

           copy_prog_des_to_app_prog_des (module_index, load_module^.description, load_module^.changed_info,
                 applic_program_header, temporary_library, status);
           IF NOT status.normal THEN
             RETURN;
           IFEND;

           module_dictionary^ [module_index].applic_program_header :=
                 #REL (applic_program_header, temporary_library^);
         ELSE
           module_dictionary^ [module_index].kind := llc$program_description;

           copy_program_description (module_index, load_module^.description, load_module^.changed_info,
                 program_header, temporary_library, status);
           IF NOT status.normal THEN
             RETURN;
           IFEND;

           module_dictionary^ [module_index].program_header := #REL (program_header, temporary_library^);
         IFEND;

         add_to_command_dictionary (module_dictionary^ [module_index], temporary_library, next_command,
               command_dictionary);

       = occ$command_procedure =
         IF (load_module^.changed_info <> NIL) AND (load_module^.changed_info^.application_identifier <>
               NIL) AND (load_module^.changed_info^.application_identifier^.name <> osc$null_name) THEN
           module_dictionary^ [module_index].kind := llc$applic_command_procedure;

           copy_scl_proc_to_app_scl_proc (module_index, load_module^.description, load_module^.changed_info,
                 applic_command_header, temporary_library, status);
           IF NOT status.normal THEN
             RETURN;
           IFEND;

           module_dictionary^ [module_index].applic_command_header :=
                 #REL (applic_command_header, temporary_library^);
         ELSE
           module_dictionary^ [module_index].kind := llc$command_procedure;

           copy_scl_procedure (module_index, load_module^.description, load_module^.changed_info,
                 command_header, temporary_library, status);
           IF NOT status.normal THEN
             RETURN;
           IFEND;

           module_dictionary^ [module_index].command_header := #REL (command_header, temporary_library^);
         IFEND;

         add_to_command_dictionary (module_dictionary^ [module_index], temporary_library, next_command,
               command_dictionary);

       = occ$command_description =
         IF (load_module^.changed_info <> NIL) AND (load_module^.changed_info^.application_identifier <>
               NIL) AND (load_module^.changed_info^.application_identifier^.name <> osc$null_name) THEN
           module_dictionary^ [module_index].kind := llc$applic_command_description;

           copy_cmnd_des_to_app_cmnd_des (module_index, load_module^.description, load_module^.changed_info,
                 applic_command_description_hdr, temporary_library, status);
           IF NOT status.normal THEN
             RETURN;
           IFEND;

           module_dictionary^ [module_index].applic_command_description_hdr :=
                 #REL (applic_command_description_hdr, temporary_library^);
         ELSE
           module_dictionary^ [module_index].kind := llc$command_description;

           copy_command_description (module_index, load_module^.description, load_module^.changed_info,
                 command_description_header, temporary_library, status);
           IF NOT status.normal THEN
             RETURN;
           IFEND;

           module_dictionary^ [module_index].command_description_header :=
                 #REL (command_description_header, temporary_library^);
         IFEND;

         add_to_command_dictionary (module_dictionary^ [module_index], temporary_library, next_command,
               command_dictionary);

       = occ$function_procedure =
         module_dictionary^ [module_index].kind := llc$function_procedure;

         copy_scl_procedure (module_index, load_module^.description, load_module^.changed_info,
               function_header, temporary_library, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;

         module_dictionary^ [module_index].function_header := #REL (function_header, temporary_library^);

         add_to_function_dictionary (module_dictionary^ [module_index], temporary_library, next_function,
               function_dictionary);

       = occ$function_description =
         module_dictionary^ [module_index].kind := llc$function_description;

         copy_function_description (module_index, load_module^.description, load_module^.changed_info,
               function_description_header, temporary_library, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;

         module_dictionary^ [module_index].function_description_header :=
               #REL (function_description_header, temporary_library^);

         add_to_function_dictionary (module_dictionary^ [module_index], temporary_library, next_function,
               function_dictionary);

       = occ$message_module =
         module_dictionary^ [module_index].kind := llc$message_module;

         copy_message_module (module_index, load_module^.description, load_module^.changed_info,
               message_header, temporary_library, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;

         module_dictionary^ [module_index].message_header := #REL (message_header, temporary_library^);

         add_to_msg_or_help_module_dicts (module_dictionary^ [module_index], temporary_library,
               next_help_module, next_message_module, message_module_dictionary);

       = occ$panel_module =
         module_dictionary^ [module_index].kind := llc$panel_module;

         copy_panel_module (module_index, load_module^.description, load_module^.changed_info, panel_header,
               temporary_library, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;

         module_dictionary^ [module_index].panel_header := #REL (panel_header, temporary_library^);

         add_to_panel_dictionary (module_dictionary^ [module_index], temporary_library, next_panel,
               panel_dictionary);

       = occ$temporary_load_module =
         module_dictionary^ [module_index].kind := llc$load_module;

         copy_temporary_load_module (module_index, load_module^.description, load_module_header, code_section,
               read_section, temporary_library, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;

         module_dictionary^ [module_index].module_header := #REL (load_module_header, temporary_library^);

         add_to_entry_point_dictionary (module_dictionary^ [module_index], temporary_library,
               next_entry_point, entry_point_dictionary);

         add_to_command_dictionary (module_dictionary^ [module_index], temporary_library, next_command,
               command_dictionary);

       = occ$applic_program_description =
         IF (load_module^.changed_info <> NIL) AND (load_module^.changed_info^.application_identifier <>
               NIL) AND (load_module^.changed_info^.application_identifier^.name = osc$null_name) THEN
           module_dictionary^ [module_index].kind := llc$program_description;

           copy_app_prog_des_to_prog_des (module_index, load_module^.description, load_module^.changed_info,
                 program_header, temporary_library, status);
           IF NOT status.normal THEN
             RETURN;
           IFEND;

           module_dictionary^ [module_index].program_header := #REL (program_header, temporary_library^);
         ELSE
           module_dictionary^ [module_index].kind := llc$applic_program_description;

           copy_applic_program_description (module_index, load_module^.description, load_module^.changed_info,
                 applic_program_header, temporary_library, status);
           IF NOT status.normal THEN
             RETURN;
           IFEND;

           module_dictionary^ [module_index].applic_program_header :=
                 #REL (applic_program_header, temporary_library^);
         IFEND;

         add_to_command_dictionary (module_dictionary^ [module_index], temporary_library, next_command,
               command_dictionary);

       = occ$applic_command_procedure =
         IF (load_module^.changed_info <> NIL) AND (load_module^.changed_info^.application_identifier <>
               NIL) AND (load_module^.changed_info^.application_identifier^.name = osc$null_name) THEN
           module_dictionary^ [module_index].kind := llc$command_procedure;

           copy_app_scl_proc_to_scl_proc (module_index, load_module^.description, load_module^.changed_info,
                 command_header, temporary_library, status);
           IF NOT status.normal THEN
             RETURN;
           IFEND;

           module_dictionary^ [module_index].command_header := #REL (command_header, temporary_library^);
         ELSE
           module_dictionary^ [module_index].kind := llc$applic_command_procedure;

           copy_applic_command_procedure (module_index, load_module^.description, load_module^.changed_info,
                 applic_command_header, temporary_library, status);
           IF NOT status.normal THEN
             RETURN;
           IFEND;

           module_dictionary^ [module_index].applic_command_header :=
                 #REL (applic_command_header, temporary_library^);
         IFEND;

         add_to_command_dictionary (module_dictionary^ [module_index], temporary_library, next_command,
               command_dictionary);

       = occ$applic_command_description =
         IF (load_module^.changed_info <> NIL) AND (load_module^.changed_info^.application_identifier <>
               NIL) AND (load_module^.changed_info^.application_identifier^.name = osc$null_name) THEN
           module_dictionary^ [module_index].kind := llc$command_description;

           copy_app_cmnd_des_to_cmnd_des (module_index, load_module^.description, load_module^.changed_info,
                 command_description_header, temporary_library, status);
           IF NOT status.normal THEN
             RETURN;
           IFEND;

           module_dictionary^ [module_index].command_description_header :=
                 #REL (command_description_header, temporary_library^);
         ELSE
           module_dictionary^ [module_index].kind := llc$applic_command_description;

           copy_applic_command_description (module_index, load_module^.description, load_module^.changed_info,
                 applic_command_description_hdr, temporary_library, status);
           IF NOT status.normal THEN
             RETURN;
           IFEND;

           module_dictionary^ [module_index].applic_command_description_hdr :=
                 #REL (applic_command_description_hdr, temporary_library^);
         IFEND;

         add_to_command_dictionary (module_dictionary^ [module_index], temporary_library, next_command,
               command_dictionary);

       CASEND;

       load_module := load_module^.link;

     UNTIL load_module = NIL;
     mmp$preset_page_streaming ({preset_and_save_ts_fb} FALSE, temporary_library, prestreaming_transfer_size,
           save_temp_transfer_size, save_temp_free_behind, status);
     IF NOT status.normal THEN
       RETURN;
     IFEND;

     IF last_segment_number <> 0 THEN
       pva_p := #ADDRESS (#RING (pva_p), last_segment_number, 0);
       mmp$preset_page_streaming ({preset_and_save_ts_fb} FALSE, pva_p, prestreaming_transfer_size,
             save_transfer_size, save_free_behind, status);
     IFEND;
   PROCEND write_header_interpretive_info;
?? OLDTITLE ??
?? NEWTITLE := '          WRITE_INFORMATION_ELEMENTS' ??
?? EJECT ??

   PROCEDURE write_information_elements
     (    load_module_list: oct$load_module_list;
          module_dictionary: ^llt$module_dictionary;
      VAR temporary_library: ^SEQ ( * );
      VAR status: ost$status);




     PROCEDURE [XREF] ocp$relocate_seg_definitions
       (    relocation: ^llt$relocation;
            segment_relocation_info: ^oct$segment_relocation_info);

?? NEWTITLE := '            COPY_OLD_INFO_ELEMENT' ??
?? EJECT ??

     PROCEDURE copy_old_info_element
       (    old_info_element_header: ^llt$info_element_header;
            old_load_module: ^oct$module_description;
        VAR new_info_element_header: ^llt$info_element_header;
        VAR temporary_library: ^SEQ ( * );
        VAR status: ost$status);


       VAR
         old_relocation_items: ^llt$relocation,
         old_components: ^llt$component_information,
         old_template_items: ^llt$binding_section_template,
         old_section_maps: ^llt$section_maps,
         old_map: ^llt$section_map_items,

         new_relocation_items: ^llt$relocation,
         new_components: ^llt$component_information,
         new_template_items: ^llt$binding_section_template,
         new_section_maps: ^llt$section_maps,
         new_map: ^llt$section_map_items,
         i,
         j: integer;



       new_info_element_header^ := old_info_element_header^;

       IF old_info_element_header^.number_of_rel_items <> 0 THEN
         old_relocation_items := #PTR (old_info_element_header^.relocation_ptr, old_load_module^.file^);
         IF old_relocation_items = NIL THEN
           osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, old_load_module^.name, status);
           RETURN;
         IFEND;

         NEXT new_relocation_items: [1 .. new_info_element_header^.number_of_rel_items] IN temporary_library;
         IF new_relocation_items = NIL THEN
           osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
           RETURN;
         IFEND;

         new_info_element_header^.relocation_ptr := #REL (new_relocation_items, temporary_library^);
         new_relocation_items^ := old_relocation_items^;

         IF old_load_module^.segment_relocation_info <> NIL THEN
           ocp$relocate_seg_definitions (new_relocation_items, old_load_module^.segment_relocation_info);
         IFEND;
       IFEND;

       IF old_info_element_header^.number_of_components <> 0 THEN
         old_components := #PTR (old_info_element_header^.component_ptr, old_load_module^.file^);
         IF old_components = NIL THEN
           osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, old_load_module^.name, status);
           RETURN;
         IFEND;

         NEXT new_components: [1 .. new_info_element_header^.number_of_components] IN temporary_library;
         IF new_components = NIL THEN
           osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
           RETURN;
         IFEND;

         new_info_element_header^.component_ptr := #REL (new_components, temporary_library^);
         new_components^ := old_components^;
       IFEND;


       IF old_info_element_header^.number_of_template_items <> 0 THEN
         old_template_items := #PTR (old_info_element_header^.binding_template_ptr, old_load_module^.file^);
         IF old_template_items = NIL THEN
           osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, old_load_module^.name, status);
           RETURN;
         IFEND;

         NEXT new_template_items: [1 .. new_info_element_header^.number_of_template_items] IN
               temporary_library;
         IF new_template_items = NIL THEN
           osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
           RETURN;
         IFEND;

         new_info_element_header^.binding_template_ptr := #REL (new_template_items, temporary_library^);
         new_template_items^ := old_template_items^;
       IFEND;

       IF old_info_element_header^.number_of_section_maps <> 0 THEN
         old_section_maps := #PTR (old_info_element_header^.section_maps, old_load_module^.file^);
         IF old_section_maps = NIL THEN
           osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, old_load_module^.name, status);
           RETURN;
         IFEND;

         NEXT new_section_maps: [0 .. UPPERBOUND (old_section_maps^)] IN temporary_library;
         IF new_section_maps = NIL THEN
           osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
           RETURN;
         IFEND;

         new_info_element_header^.section_maps := #REL (new_section_maps, temporary_library^);
         new_section_maps^ := old_section_maps^;


         FOR i := 0 TO UPPERBOUND (old_section_maps^) DO
           IF old_section_maps^ [i].number_of_items <> 0 THEN
             old_map := #PTR (old_section_maps^ [i].map, old_load_module^.file^);
             IF old_map = NIL THEN
               osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, old_load_module^.name, status);
               RETURN;
             IFEND;

             NEXT new_map: [1 .. new_section_maps^ [i].number_of_items] IN temporary_library;
             IF new_map = NIL THEN
               osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
               RETURN;
             IFEND;

             new_section_maps^ [i].map := #REL (new_map, temporary_library^);
             new_map^ := old_map^;
           IFEND;
         FOREND;
       IFEND;


     PROCEND copy_old_info_element;
?? OLDTITLE ??
?? NEWTITLE := '            COPY_OLD_INFORMATION_ELEMENT' ??
?? EJECT ??

     PROCEDURE copy_old_information_element
       (    old_load_module: ^oct$module_description;
            new_load_module_header: ^llt$load_module_header;
        VAR temporary_library: ^SEQ ( * );
        VAR status: ost$status);


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


       IF llc$information_element IN old_load_module^.load_module_header^.elements_defined THEN
         new_load_module_header^.elements_defined := new_load_module_header^.elements_defined +
               $llt$load_module_elements [llc$information_element];
         NEXT new_info_element_header IN temporary_library;
         IF new_info_element_header = NIL THEN
           osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
           RETURN;
         IFEND;

         new_load_module_header^.information_element := #REL (new_info_element_header, temporary_library^);


         old_info_element_header := #PTR (old_load_module^.load_module_header^.information_element,
               old_load_module^.file^);
         IF old_info_element_header = NIL THEN
           osp$set_status_abnormal (oc, oce$e_premature_eof_in_module, old_load_module^.name, status);
           RETURN;
         IFEND;

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

         copy_old_info_element (old_info_element_header, old_load_module, new_info_element_header,
               temporary_library, status);
         IF NOT status.normal THEN
           RETURN;
         IFEND;
       IFEND;


     PROCEND copy_old_information_element;
?? OLDTITLE ??
?? NEWTITLE := '            BUILD_BINARY_SECTION_MAPS', EJECT ??

     PROCEDURE build_binary_section_maps
       (    section_definition_list: oct$section_definition_list;
        VAR number_of_section_maps: llt$number_of_sections;
        VAR section_maps_relative_pointer: REL (llt$object_library) ^array [0 .. * ] of llt$section_map;
        VAR temporary_library: ^SEQ ( * );
        VAR status: ost$status);


       VAR
         section_definition: ^oct$section_definition_list,
         old_section: ^oct$old_section_list,
         section_maps: ^llt$section_maps,
         map: ^llt$section_map_items,
         old_map: ^llt$section_map_items,
         new_map: ^llt$section_map_items,
         item: ^llt$section_map_item,
         reset_value: ^SEQ ( * ),
         count: integer,
         i: integer,
         j: integer;


       section_definition := section_definition_list.link;
       number_of_section_maps := 0;

       WHILE section_definition <> NIL DO
         section_definition := section_definition^.link;
         number_of_section_maps := number_of_section_maps + 1;
       WHILEND;

       NEXT section_maps: [0 .. (number_of_section_maps - 1)] IN temporary_library;
       IF section_maps = NIL THEN
         osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, 'BBSM1', status);
         RETURN;
       IFEND;

       section_maps_relative_pointer := #REL (section_maps, temporary_library^);

       FOR i := 0 TO (number_of_section_maps - 1) DO
         section_definition := section_definition_list.link;
         WHILE (section_definition^.section_definition.section_ordinal <> i) DO
           section_definition := section_definition^.link;
         WHILEND;

         reset_value := temporary_library;
         old_section := section_definition^.old_sections.link;
         count := 0;

         IF section_definition^.section_definition.kind <> llc$binding_section THEN
           WHILE old_section <> NIL DO
             IF old_section^.component^.section_maps = NIL THEN
               NEXT item IN temporary_library;
               IF item = NIL THEN
                 osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, 'BBSM2', status);
                 RETURN;
               IFEND;

               count := count + 1;
               item^.original_section_ordinal := old_section^.section_ordinal;
               item^.offset := old_section^.component^.section_definitions^ [old_section^.section_ordinal]^.
                     new_section_offset;
               item^.length := old_section^.component^.section_definitions^ [old_section^.section_ordinal]^.
                     section_definition.length;
               item^.name := old_section^.component^.section_definitions^ [old_section^.section_ordinal]^.
                     section_definition.name;
               item^.component := old_section^.component^.component_number;

             ELSEIF old_section^.component^.section_maps^ [old_section^.section_ordinal].number_of_items <>
                   0 THEN
               old_map := #PTR (old_section^.component^.section_maps^ [old_section^.section_ordinal].map,
                     old_section^.component^.file^);
               NEXT new_map: [1 .. UPPERBOUND (old_map^)] IN temporary_library;
               IF new_map = NIL THEN
                 osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, 'BBSM3', status);
                 RETURN;
               IFEND;

               new_map^ := old_map^;
               count := count + UPPERBOUND (new_map^);

               FOR j := 1 TO UPPERBOUND (new_map^) DO
                 new_map^ [j].offset := new_map^ [j].offset + old_section^.component^.
                       section_definitions^ [old_section^.section_ordinal]^.new_section_offset;
                 new_map^ [j].component := old_section^.component^.components^ [new_map^ [j].component].
                       new_component_number;
               FOREND;
             IFEND;

             old_section := old_section^.link;
           WHILEND;
         IFEND;


         section_maps^ [i].number_of_items := count;

         IF count > 0 THEN
           temporary_library := reset_value;
           NEXT map: [1 .. count] IN temporary_library;
           section_maps^ [i].map := #REL (map, temporary_library^);
         IFEND;
       FOREND;


     PROCEND build_binary_section_maps;
?? OLDTITLE ??
?? NEWTITLE := '            COPY_NEW_INFORMATION_ELEMENT' ??
?? EJECT ??

     PROCEDURE copy_new_information_element
       (    temp_load_module: ^oct$module_description;
            new_load_module_header: ^llt$load_module_header;
        VAR temporary_library: ^SEQ ( * );
        VAR status: ost$status);


       VAR
         new_info_element_hdr: ^llt$info_element_header,
         new_relocation_items: ^llt$relocation,
         new_components: ^llt$component_information,
         new_template_items: ^llt$binding_section_template,

         i: integer,
         next_relocation_item: ^oct$relocation_list,
         next_template_item: ^oct$new_binding_template_list;


       IF (temp_load_module^.temporary_module_header^.number_of_rel_items <> 0) OR
             (UPPERBOUND (temp_load_module^.temporary_module_header^.component_info^) > 1) OR
             (temp_load_module^.temporary_module_header^.number_of_template_items <> 0) OR
             (temp_load_module^.temporary_module_header^.include_binary_section_maps) THEN

         new_load_module_header^.elements_defined := new_load_module_header^.elements_defined +
               $llt$load_module_elements [llc$information_element];

         NEXT new_info_element_hdr IN temporary_library;
         IF new_info_element_hdr = NIL THEN
           osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
           RETURN;
         IFEND;

         new_load_module_header^.information_element := #REL (new_info_element_hdr, temporary_library^);

         new_info_element_hdr^.version := llc$info_element_version;

         new_info_element_hdr^.number_of_rel_items := temp_load_module^.temporary_module_header^.
               number_of_rel_items;
         IF new_info_element_hdr^.number_of_rel_items <> 0 THEN

           NEXT new_relocation_items: [1 .. new_info_element_hdr^.number_of_rel_items] IN temporary_library;
           IF new_relocation_items = NIL THEN
             osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
             RETURN;
           IFEND;

           new_info_element_hdr^.relocation_ptr := #REL (new_relocation_items, temporary_library^);
           next_relocation_item := temp_load_module^.temporary_module_header^.relocation_list.link;

           FOR i := 1 TO new_info_element_hdr^.number_of_rel_items DO
             new_relocation_items^ [i] := next_relocation_item^.relocation_item;
             next_relocation_item := next_relocation_item^.link;
           FOREND;

           IF temp_load_module^.segment_relocation_info <> NIL THEN
             ocp$relocate_seg_definitions (new_relocation_items, temp_load_module^.segment_relocation_info);
           IFEND;
         IFEND;


         new_info_element_hdr^.number_of_components := UPPERBOUND (temp_load_module^.temporary_module_header^.
               component_info^);
         IF (new_info_element_hdr^.number_of_components = 1) AND
               (NOT temp_load_module^.temporary_module_header^.include_binary_section_maps) THEN
           new_info_element_hdr^.number_of_components := 0;

         ELSE
           NEXT new_components: [1 .. new_info_element_hdr^.number_of_components] IN temporary_library;
           IF new_components = NIL THEN
             osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
             RETURN;
           IFEND;

           new_info_element_hdr^.component_ptr := #REL (new_components, temporary_library^);
           new_components^ := temp_load_module^.temporary_module_header^.component_info^;
         IFEND;

         new_info_element_hdr^.number_of_template_items := temp_load_module^.temporary_module_header^.
               number_of_template_items;
         IF new_info_element_hdr^.number_of_template_items <> 0 THEN
           NEXT new_template_items: [1 .. new_info_element_hdr^.number_of_template_items] IN
                 temporary_library;
           IF new_template_items = NIL THEN
             osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
             RETURN;
           IFEND;

           new_info_element_hdr^.binding_template_ptr := #REL (new_template_items, temporary_library^);
           next_template_item := temp_load_module^.temporary_module_header^.binding_template_list.link;

           FOR i := 1 TO new_info_element_hdr^.number_of_template_items DO
             new_template_items^ [i] := next_template_item^.binding_template;
             next_template_item := next_template_item^.link;
           FOREND;
         IFEND;


         IF temp_load_module^.temporary_module_header^.include_binary_section_maps THEN
           build_binary_section_maps (temp_load_module^.temporary_module_header^.section_definitions,
                 new_info_element_hdr^.number_of_section_maps, new_info_element_hdr^.section_maps,
                 temporary_library, status);
           IF NOT status.normal THEN
             RETURN;
           IFEND;
         ELSE
           new_info_element_hdr^.number_of_section_maps := 0;
         IFEND;
       IFEND;


     PROCEND copy_new_information_element;
?? OLDTITLE ??
?? EJECT ??




     VAR
       load_module: ^oct$load_module_list,
       new_load_module_header: ^llt$load_module_header,

       i: llt$module_index;


     load_module := load_module_list.link;
     i := 0;

     REPEAT
       i := i + 1;

       IF (load_module^.description^.kind = occ$load_module) OR
             (load_module^.description^.kind = occ$temporary_load_module) THEN
         new_load_module_header := #PTR (module_dictionary^ [i].module_header, temporary_library^);

         CASE load_module^.description^.kind OF
         = occ$load_module =
           copy_old_information_element (load_module^.description, new_load_module_header, temporary_library,
                 status);

         = occ$temporary_load_module =
           copy_new_information_element (load_module^.description, new_load_module_header, temporary_library,
                 status);

         CASEND;
       IFEND;

       IF NOT status.normal THEN
         RETURN;
       IFEND;

       load_module := load_module^.link;

     UNTIL load_module = NIL;


   PROCEND write_information_elements;

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

   PROCEDURE sort_command_dictionary
     (VAR commands: llt$command_dictionary);


     VAR
       left: integer,
       right: integer,
       i: integer,
       j: integer,
       number: integer,
       temp: llt$command_dictionary_item,
       key: pmt$program_name;


     number := UPPERBOUND (commands);

     IF (number = 1) THEN
       RETURN;
     ELSEIF (number = 2) THEN
       IF (commands [1].name > commands [2].name) THEN
         temp := commands [1];
         commands [1] := commands [2];
         commands [2] := temp;
       IFEND;
       RETURN;
     IFEND;

     left := (number DIV 2) + 1;
     right := number;

   /outer_loop/
     WHILE (TRUE) DO
       IF (left > 1) THEN
         left := left - 1;
         temp := commands [left];
         key := commands [left].name;
       ELSE
         temp := commands [right];
         key := commands [right].name;
         commands [right] := commands [1];
         right := right - 1;
         IF (right = 1) THEN
           commands [right] := temp;
           RETURN;
         IFEND;
       IFEND;

       j := left;

     /inner_loop/
       WHILE (TRUE) DO
         i := j;
         j := j + j;

         IF (j < right) THEN
           IF (commands [j].name < commands [j + 1].name) THEN
             j := j + 1;
           IFEND;
         ELSEIF (j > right) THEN
           EXIT /inner_loop/;
         IFEND;

         IF (key >= commands [j].name) THEN
           EXIT /inner_loop/;
         IFEND;

         commands [i] := commands [j];
       WHILEND /inner_loop/;

       commands [i] := temp;
     WHILEND /outer_loop/;


   PROCEND sort_command_dictionary;
?? OLDTITLE ??
?? NEWTITLE := '        SORT_FUNCTION_DICTIONARY', EJECT ??

   PROCEDURE sort_function_dictionary
     (VAR functions: llt$function_dictionary);


     VAR
       left: integer,
       right: integer,
       i: integer,
       j: integer,
       number: integer,
       temp: llt$function_dictionary_item,
       key: pmt$program_name;


     number := UPPERBOUND (functions);

     IF (number = 1) THEN
       RETURN;
     ELSEIF (number = 2) THEN
       IF (functions [1].name > functions [2].name) THEN
         temp := functions [1];
         functions [1] := functions [2];
         functions [2] := temp;
       IFEND;
       RETURN;
     IFEND;

     left := (number DIV 2) + 1;
     right := number;

   /outer_loop/
     WHILE (TRUE) DO
       IF (left > 1) THEN
         left := left - 1;
         temp := functions [left];
         key := functions [left].name;
       ELSE
         temp := functions [right];
         key := functions [right].name;
         functions [right] := functions [1];
         right := right - 1;
         IF (right = 1) THEN
           functions [right] := temp;
           RETURN;
         IFEND;
       IFEND;

       j := left;

     /inner_loop/
       WHILE (TRUE) DO
         i := j;
         j := j + j;

         IF (j < right) THEN
           IF (functions [j].name < functions [j + 1].name) THEN
             j := j + 1;
           IFEND;
         ELSEIF (j > right) THEN
           EXIT /inner_loop/;
         IFEND;

         IF (key >= functions [j].name) THEN
           EXIT /inner_loop/;
         IFEND;

         functions [i] := functions [j];
       WHILEND /inner_loop/;

       functions [i] := temp;
     WHILEND /outer_loop/;


   PROCEND sort_function_dictionary;
?? OLDTITLE ??
?? NEWTITLE := '        SORT_MESSAGE_MODULE_DICTIONARY', EJECT ??

   PROCEDURE sort_message_module_dictionary
     (VAR message_modules: llt$message_module_dictionary);


     VAR
       left: integer,
       right: integer,
       i: integer,
       j: integer,
       number: integer,
       temp: llt$message_module_dict_item,
       key: pmt$program_name;


     number := UPPERBOUND (message_modules);

     IF (number = 1) THEN
       RETURN;
     ELSEIF (number = 2) THEN
       IF (message_modules [1].name > message_modules [2].name) THEN
         temp := message_modules [1];
         message_modules [1] := message_modules [2];
         message_modules [2] := temp;
       IFEND;
       RETURN;
     IFEND;

     left := (number DIV 2) + 1;
     right := number;

   /outer_loop/
     WHILE (TRUE) DO
       IF (left > 1) THEN
         left := left - 1;
         temp := message_modules [left];
         key := message_modules [left].name;
       ELSE
         temp := message_modules [right];
         key := message_modules [right].name;
         message_modules [right] := message_modules [1];
         right := right - 1;
         IF (right = 1) THEN
           message_modules [right] := temp;
           RETURN;
         IFEND;
       IFEND;

       j := left;

     /inner_loop/
       WHILE (TRUE) DO
         i := j;
         j := j + j;

         IF (j < right) THEN
           IF (message_modules [j].name < message_modules [j + 1].name) THEN
             j := j + 1;
           IFEND;
         ELSEIF (j > right) THEN
           EXIT /inner_loop/;
         IFEND;

         IF (key >= message_modules [j].name) THEN
           EXIT /inner_loop/;
         IFEND;

         message_modules [i] := message_modules [j];
       WHILEND /inner_loop/;

       message_modules [i] := temp;
     WHILEND /outer_loop/;


   PROCEND sort_message_module_dictionary;
?? OLDTITLE ??
?? NEWTITLE := '        SORT_HELP_MODULE_DICTIONARY', EJECT ??

   PROCEDURE sort_help_module_dictionary
     (VAR help_modules: llt$help_module_dictionary);


     VAR
       left: integer,
       right: integer,
       i: integer,
       j: integer,
       number: integer,
       temp: llt$help_module_dictionary_item,
       key: pmt$program_name;


     number := UPPERBOUND (help_modules);

     IF (number = 1) THEN
       RETURN;
     ELSEIF (number = 2) THEN
       IF (help_modules [1].name > help_modules [2].name) THEN
         temp := help_modules [1];
         help_modules [1] := help_modules [2];
         help_modules [2] := temp;
       IFEND;
       RETURN;
     IFEND;

     left := (number DIV 2) + 1;
     right := number;

   /outer_loop/
     WHILE (TRUE) DO
       IF (left > 1) THEN
         left := left - 1;
         temp := help_modules [left];
         key := help_modules [left].name;
       ELSE
         temp := help_modules [right];
         key := help_modules [right].name;
         help_modules [right] := help_modules [1];
         right := right - 1;
         IF (right = 1) THEN
           help_modules [right] := temp;
           RETURN;
         IFEND;
       IFEND;

       j := left;

     /inner_loop/
       WHILE (TRUE) DO
         i := j;
         j := j + j;

         IF (j < right) THEN
           IF (help_modules [j].name < help_modules [j + 1].name) THEN
             j := j + 1;
           IFEND;
         ELSEIF (j > right) THEN
           EXIT /inner_loop/;
         IFEND;

         IF (key >= help_modules [j].name) THEN
           EXIT /inner_loop/;
         IFEND;

         help_modules [i] := help_modules [j];
       WHILEND /inner_loop/;

       help_modules [i] := temp;
     WHILEND /outer_loop/;


   PROCEND sort_help_module_dictionary;
?? OLDTITLE ??
?? NEWTITLE := '        SORT_PANEL_DICTIONARY', EJECT ??

   PROCEDURE sort_panel_dictionary
     (VAR panels: llt$panel_dictionary);


     VAR
       left: integer,
       right: integer,
       i: integer,
       j: integer,
       number: integer,
       temp: llt$panel_dictionary_item,
       key: pmt$program_name;


     number := UPPERBOUND (panels);

     IF (number = 1) THEN
       RETURN;
     ELSEIF (number = 2) THEN
       IF (panels [1].name > panels [2].name) THEN
         temp := panels [1];
         panels [1] := panels [2];
         panels [2] := temp;
       IFEND;
       RETURN;
     IFEND;

     left := (number DIV 2) + 1;
     right := number;

   /outer_loop/
     WHILE (TRUE) DO
       IF (left > 1) THEN
         left := left - 1;
         temp := panels [left];
         key := panels [left].name;
       ELSE
         temp := panels [right];
         key := panels [right].name;
         panels [right] := panels [1];
         right := right - 1;
         IF (right = 1) THEN
           panels [right] := temp;
           RETURN;
         IFEND;
       IFEND;

       j := left;

     /inner_loop/
       WHILE (TRUE) DO
         i := j;
         j := j + j;

         IF (j < right) THEN
           IF (panels [j].name < panels [j + 1].name) THEN
             j := j + 1;
           IFEND;
         ELSEIF (j > right) THEN
           EXIT /inner_loop/;
         IFEND;

         IF (key >= panels [j].name) THEN
           EXIT /inner_loop/;
         IFEND;

         panels [i] := panels [j];
       WHILEND /inner_loop/;

       panels [i] := temp;
     WHILEND /outer_loop/;


   PROCEND sort_panel_dictionary;
?? OLDTITLE ??
?? EJECT ??

   CONST
     for_code_sections = TRUE,
     for_read_sections = FALSE;


   VAR
     page_size: ost$page_size,

     code_section_element: ^llt$code_element,
     read_section_element: ^llt$code_element,

     code_section: ^cell,
     read_section: ^cell,

     code_section_length: ost$segment_length,
     read_section_length: ost$segment_length,

     module_dictionary: ^llt$module_dictionary,
     entry_point_dictionary: ^llt$entry_point_dictionary,
     command_dictionary: ^llt$command_dictionary,
     function_dictionary: ^llt$function_dictionary,
     help_module_dictionary: ^llt$help_module_dictionary,
     message_module_dictionary: ^llt$message_module_dictionary,
     panel_dictionary: ^llt$panel_dictionary;


   pmp$get_page_size (page_size, status);
   IF NOT status.normal THEN
     RETURN;
   IFEND;


   RESET temporary_library;

   write_header_and_dictionaries (load_module_list, module_dictionary, entry_point_dictionary,
         command_dictionary, function_dictionary, help_module_dictionary, message_module_dictionary,
         panel_dictionary, temporary_library, status);

   IF NOT status.normal THEN
     RETURN;
   IFEND;


   skip_to_page_boundry (page_size, temporary_library);

   compute_section_length (for_code_sections, load_module_list, temporary_library, code_section_length,
         status);

   IF NOT status.normal THEN
     RETURN;
   IFEND;

   IF code_section_length <> 0 THEN
     NEXT code_section_element: [1 .. code_section_length] IN temporary_library;
     IF code_section_element = NIL THEN
       osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
       RETURN;
     IFEND;
     code_section := #LOC (code_section_element^);
   ELSE
     code_section := NIL;
   IFEND;



   compute_section_length (for_read_sections, load_module_list, temporary_library, read_section_length,
         status);

   IF NOT status.normal THEN
     RETURN;
   IFEND;

   IF read_section_length <> 0 THEN
     NEXT read_section_element: [1 .. read_section_length] IN temporary_library;
     IF read_section_element = NIL THEN
       osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
       RETURN;
     IFEND;
     read_section := #LOC (read_section_element^);
   ELSE
     read_section := NIL;
   IFEND;


   IF (code_section_length + read_section_length) <> 0 THEN
     skip_to_page_boundry (page_size, temporary_library);
   IFEND;

   write_header_interpretive_info (load_module_list, temporary_library, module_dictionary,
         entry_point_dictionary, command_dictionary, function_dictionary, help_module_dictionary,
         message_module_dictionary, panel_dictionary, code_section, read_section, status);

   IF NOT status.normal THEN
     RETURN;
   IFEND;



   skip_to_page_boundry (page_size, temporary_library);

   write_information_elements (load_module_list, module_dictionary, temporary_library, status);

   IF NOT status.normal THEN
     RETURN;
   IFEND;

   IF command_dictionary <> NIL THEN
     sort_command_dictionary (command_dictionary^);
   IFEND;

   IF function_dictionary <> NIL THEN
     sort_function_dictionary (function_dictionary^);
   IFEND;

   IF message_module_dictionary <> NIL THEN
     sort_message_module_dictionary (message_module_dictionary^);
   IFEND;

   IF help_module_dictionary <> NIL THEN
     sort_help_module_dictionary (help_module_dictionary^);
   IFEND;

   IF panel_dictionary <> NIL THEN
     sort_panel_dictionary (panel_dictionary^);
   IFEND;




 PROCEND generate_temporary_library;
?? OLDTITLE ??
?? EJECT ??


 VAR
   load_module_list: oct$load_module_list;


 build_load_module_list (ocv$nlm_list, load_module_list, status);


 IF status.normal THEN

   generate_temporary_library (load_module_list, temporary_library_file, status);

 IFEND;


 PROCEND generate_temporary_library_file;
?? OLDTITLE ??
?? NEWTITLE := 'add_modules_from_temporary_back', EJECT ??

{ PURPOSE:
{   The purpose of this request is to recover the generated library or file
{   to allow the user the opportunity to re-enter the generate_library
{   subcommand.
{ DESIGN:
{   This procedure basically does an "add_module" of the temporary segment.
{ NOTES:
{   Since the library or file has already been generated successfully,
{   (up to the point of writing to the output file) there is no need to check
{   for NIL pointers or bad status from the procedure calls.


 PROCEDURE add_modules_from_temporary_back
   (    format: clt$keyword;
    VAR temporary: amt$segment_pointer);

   VAR
     addition_list: oct$nlm_modification_list,
     current_module: 1 .. llc$max_modules_in_library + 1,
     file_descriptor: ^oct$open_file_list,
     ignore_status: ost$status,
     last_addition: ^oct$nlm_modification_list;


   ocp$initialize_olg_working_heap;
   RESET ocv$olg_scratch_seq;

   ALLOCATE file_descriptor IN ocv$olg_working_heap^;
   file_descriptor^.name := 'TEMPORARY';

   IF format = 'FILE' THEN
     file_descriptor^.kind := occ$file;

{ The procedure ocp$build_file_dir_from_temp is dependent on the temporary
{ sequence being positioned at the end of the last module. Do NOT reset the
{ sequence before this call.

     ocp$build_file_dir_from_temp (temporary.sequence_pointer, file_descriptor);

   ELSE {format = 'LIBRARY'
     file_descriptor^.kind := occ$library;
     ocp$build_library_directory (temporary.sequence_pointer, file_descriptor, ignore_status);
   IFEND;

   addition_list.link := NIL;
   last_addition := ^addition_list;

   FOR current_module := 1 TO UPPERBOUND (file_descriptor^.directory^) DO
     NEXT last_addition^.link IN ocv$olg_scratch_seq;
     last_addition := last_addition^.link;

     last_addition^.link := NIL;

     ocp$create_an_nlm (^file_descriptor^.directory^ [current_module], last_addition^.nlm, ignore_status);

   FOREND;

   ocp$add_additions_to_nlm_list (ocv$nlm_list^.b_link, ^addition_list);

 PROCEND add_modules_from_temporary_back;
?? OLDTITLE ??
?? NEWTITLE := 'copy_temporary_to_output_file', EJECT ??

 PROCEDURE copy_temporary_to_output_file
   (    format: clt$keyword;
        output_file_name: fst$file_reference;
    VAR temporary: amt$segment_pointer;
    VAR status: ost$status);

?? NEWTITLE := 'copy_files', EJECT ??

   PROCEDURE copy_files
     (    format: clt$keyword;
          output_file_name: fst$file_reference;
      VAR temporary: amt$segment_pointer;
      VAR status: ost$status);

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

     PROCEDURE condition_handler
       (    condition: pmt$condition;
            condition_descriptor: ^pmt$condition_information;
            save_area: ^ost$stack_frame_save_area;
        VAR condition_status: ost$status);

{ Ignore the condition.

       RETURN;

     PROCEND condition_handler;
?? OLDTITLE, EJECT ??

     VAR
       attachment_options: array [1 .. 2] of fst$attachment_option,
       creation_validation_attributes: array [1 .. 2] of fst$file_cycle_attribute,
       output: amt$segment_pointer,
       output_file: ^SEQ ( * ),
       output_id: amt$file_identifier,
       size: ost$segment_offset,
       temporary_file: ^SEQ ( * );


     VAR
       established_conditions: pmt$condition,
       established_descriptor: pmt$established_handler;


     established_conditions.selector := pmc$condition_combination;
     established_conditions.combination := $pmt$condition_combination
           [ifc$interactive_condition, pmc$block_exit_processing];

     pmp$establish_condition_handler (established_conditions, ^condition_handler, ^established_descriptor,
           status);
     IF NOT status.normal THEN
       RETURN;
     IFEND;

     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$append, fsc$modify, fsc$shorten];
     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$delete_data;
     attachment_options [2].delete_data := TRUE;

     creation_validation_attributes [1].selector := fsc$file_contents_and_processor;
     IF format = 'LIBRARY' THEN
       creation_validation_attributes [1].file_contents := fsc$object_library;
     ELSE
       creation_validation_attributes [1].file_contents := fsc$object_data;
     IFEND;
     creation_validation_attributes [1].file_processor := amc$unknown_processor;
     creation_validation_attributes [2].selector := fsc$record_type;
     creation_validation_attributes [2].record_type := amc$undefined;
     fsp$open_file (output_file_name, amc$segment, ^attachment_options, NIL, ^creation_validation_attributes,
           ^creation_validation_attributes, NIL, output_id, status);
     IF NOT status.normal THEN
       RETURN;
     IFEND;

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

     IF output.sequence_pointer = NIL THEN
       RETURN; { $NULL }
     IFEND;

     size := i#current_sequence_position (temporary.sequence_pointer);

     IF size > 0 THEN
       RESET temporary.sequence_pointer;
       NEXT temporary_file: [[REP size OF cell]] IN temporary.sequence_pointer;

       RESET output.sequence_pointer;
       NEXT output_file: [[REP size OF cell]] IN output.sequence_pointer;
       IF output_file = NIL THEN
         osp$set_status_abnormal (oc, oce$e_eof_on_generated_file, '', status);
         RETURN;
       IFEND;

       syp$advised_move_bytes (#LOC (temporary_file^), #LOC (output_file^), size, status);
       IF NOT status.normal THEN
         RETURN;
       IFEND;
     ELSE
       RESET output.sequence_pointer;
     IFEND;

     amp$set_segment_eoi (output_id, output, status);
     IF NOT status.normal THEN
       RETURN;
     IFEND;

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

     pmp$disestablish_cond_handler (established_conditions, status);

   PROCEND copy_files;
?? OLDTITLE ??
?? EJECT ??


   status.normal := TRUE;

   ocp$close_all_open_files (ocv$open_file_list);
   ocp$return_files;

   copy_files (format, output_file_name, temporary, status);
   IF NOT status.normal THEN
     ocp$generate_message (status);
     add_modules_from_temporary_back (format, temporary);
     osp$set_status_abnormal (oc, oce$generate_not_complete, output_file_name, status);
   IFEND;

 PROCEND copy_temporary_to_output_file;
?? OLDTITLE ??
?? EJECT ??

 VAR
   temporary_file: amt$segment_pointer;


 mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, temporary_file, status);
 IF NOT status.normal THEN
   RETURN;
 IFEND;

 IF format = 'FILE' THEN
   generate_temporary_object_file (temporary_file.sequence_pointer, status);
 ELSE
   generate_temporary_library_file (temporary_file.sequence_pointer, status);
 IFEND;
 IF NOT status.normal THEN
   RETURN;
 IFEND;

 IF library_value.kind = clc$file THEN
   copy_temporary_to_output_file (format, library_value.file_value^, temporary_file, status);
   IF NOT status.normal THEN
     RETURN;
   IFEND;
 ELSE {library_value.kind = clc$keyword
   ocp$close_all_open_files (ocv$open_file_list);
   ocp$return_files;
   add_modules_from_temporary_back (format, temporary_file);
 IFEND;

 PROCEND generate_object_file;
?? OLDTITLE ??
?? EJECT ??

{ PROCEDURE (ocm$creol_genl) generate_library, genl (
{   library, l: any of
{       key
{         (new_library, nl)
{       keyend
{       file
{     anyend = $required
{   format, f: key
{       (library, l)
{       (file, f)
{       (scl_procedure, scl_proc, sp)
{       (message_module, mm)
{       (form_source, fs)
{       (form_variable, fv)
{     keyend = library
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 5] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: 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 .. 2] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 13] of clt$keyword_specification,
        default_value: string (7),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [90, 1, 9, 10, 51, 23, 102],
    clc$command, 5, 3, 1, 0, 0, 0, 3, 'OCM$CREOL_GENL'], [
    ['F                              ',clc$abbreviation_entry, 2],
    ['FORMAT                         ',clc$nominal_entry, 2],
    ['L                              ',clc$abbreviation_entry, 1],
    ['LIBRARY                        ',clc$nominal_entry, 1],
    ['STATUS                         ',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, 104,
  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, 488,
  clc$optional_default_parameter, 0, 7],
{ PARAMETER 3
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$union_type], [[clc$file_type, clc$keyword_type],
    FALSE, 2],
    81, [[1, 0, clc$keyword_type], [2], [
      ['NEW_LIBRARY                    ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['NL                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1]]
      ],
    3, [[1, 0, clc$file_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$keyword_type], [13], [
    ['F                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['FILE                           ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['FORM_SOURCE                    ', clc$nominal_entry, clc$normal_usage_entry, 5],
    ['FORM_VARIABLE                  ', clc$nominal_entry, clc$normal_usage_entry, 6],
    ['FS                             ', clc$abbreviation_entry, clc$normal_usage_entry, 5],
    ['FV                             ', clc$abbreviation_entry, clc$normal_usage_entry, 6],
    ['L                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['LIBRARY                        ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['MESSAGE_MODULE                 ', clc$nominal_entry, clc$normal_usage_entry, 4],
    ['MM                             ', clc$abbreviation_entry, clc$normal_usage_entry, 4],
    ['SCL_PROC                       ', clc$alias_entry, clc$normal_usage_entry, 3],
    ['SCL_PROCEDURE                  ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['SP                             ', clc$abbreviation_entry, clc$normal_usage_entry, 3]]
    ,
    'library'],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

    CONST
      p$library = 1,
      p$format = 2,
      p$status = 3;

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


 VAR
   ignore_status: ost$status;

 VAR
   established_conditions: pmt$condition,
   established_descriptor: pmt$established_handler;

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

{ PURPOSE:
{   The purpose of this procedure is to handle the terminate break and
{   block exit conditions.

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

   VAR
     ignore_status: ost$status,
     message: ost$status;

   IF (condition.selector = pmc$block_exit_processing) THEN
     ocp$close_all_open_files (ocv$open_file_list);
     ocp$return_files;
     ocp$initialize_olg_working_heap;
     RESET ocv$olg_scratch_seq;
   ELSEIF (condition.selector = ifc$interactive_condition) AND
         (condition.interactive_condition = ifc$terminate_break) THEN
     osp$set_status_from_condition (oc, condition, save_area, message, ignore_status);
     ocp$generate_message (message);
     osp$set_status_condition (oce$e_generate_terminated, status);
     EXIT ocp$generate;
   ELSE
     pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
   IFEND;

 PROCEND condition_handler;
?? OLDTITLE ??
?? EJECT ??

 status.normal := TRUE;
 command_status.normal := TRUE;
 established_conditions.selector := pmc$condition_combination;
 established_conditions.combination := $pmt$condition_combination
       [ifc$interactive_condition, pmc$block_exit_processing];

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

 IF ocv$nlm_list^.f_link^.name = osc$null_name THEN
   osp$set_status_abnormal (oc, oce$e_no_modules_on_current_lib, '', status);
   RETURN;
 IFEND;

 IF (pvt [p$library].value^.kind = clc$keyword) AND (pvt [p$format].value^.keyword_value <> 'LIBRARY') AND
       (pvt [p$format].value^.keyword_value <> 'FILE') THEN
   osp$set_status_abnormal (oc, oce$format_not_allowed_with_nl, pvt [p$format].value^.keyword_value, status);
   osp$append_status_parameter (osc$status_parameter_delimiter, pvt [p$library].value^.keyword_value,
         status);
   RETURN;
 IFEND;

 pmp$establish_condition_handler (established_conditions, ^condition_handler, ^established_descriptor,
       status);
 IF NOT status.normal THEN
   RETURN;
 IFEND;

 RESET ocv$olg_scratch_seq;
 mmp$set_access_selections (ocv$olg_scratch_seq, mmc$as_sequential, status);
 IF NOT status.normal THEN
   RETURN;
 IFEND;

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

 IF pvt [p$format].value^.keyword_value = 'SCL_PROCEDURE' THEN
   generate_scl_proc_file (pvt [p$library].value^.file_value^, status);

 ELSEIF pvt [p$format].value^.keyword_value = 'MESSAGE_MODULE' THEN
   generate_message_module_file (pvt [p$library].value^.file_value^, status);

 ELSEIF pvt [p$format].value^.keyword_value = 'FORM_SOURCE' THEN
   generate_form_source_file (pvt [p$library].value^.file_value^, status);

 ELSEIF pvt [p$format].value^.keyword_value = 'FORM_VARIABLE' THEN
   generate_form_variable_file (pvt [p$library].value^.file_value^, status);

 ELSE
   generate_object_file (pvt [p$format].value^.keyword_value, pvt [p$library].value^, status);
   IF (NOT status.normal) AND (status.condition <> oce$generate_not_complete) THEN
     RETURN;
   IFEND;

 IFEND;

 pmp$disestablish_cond_handler (established_conditions, ignore_status);

 IF NOT status.normal THEN
   RETURN;
 IFEND;

 status := command_status;

{ Clean up.

 IF pvt [p$library].value^.kind <> clc$keyword THEN
   ocp$close_all_open_files (ocv$open_file_list);
   ocp$return_files;
   ocp$initialize_olg_working_heap;
   RESET ocv$olg_scratch_seq;
 IFEND;

 PROCEND ocp$generate;
?? OLDTITLE ??
 MODEND ocm$generate;
