?? RIGHT := 110 ??
?? TITLE := 'NOS/VE : Loader : Module loader executive' ??
MODULE lom$module_loader;

{  PURPOSE:
{    This module contains the executive for controlling and coordinating the loading of a single
{    module.  It also contains components which process object text records which define the
{    structure (but not content) of the module being loaded.

{  NOTE:
{    Condition raised: LOE$ABORT_LOAD.

  ?VAR
    inline_procs: boolean := TRUE?;

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cyd$run_time_error_condition
*copyc lle$load_map_diagnostics
*copyc lle$loader_status_conditions
*copyc llt$actual_parameters
*copyc llt$formal_parameters
*copyc llt$obsolete_formal_parameters
*copyc loe$abort_load
*copyc loe$map_malfunction
*copyc llt$deferred_common_blocks
*copyc llt$deferred_entry_points
*copyc lot$deferred_common_blocks
*copyc lot$deferred_entry_points
*copyc lot$loader_options
*copyc lot$loader_type_definitions
*copyc oss$task_shared
*copyc oss$task_private
*copyc pmt$loadable_rings
?? POP ??
*copyc dbp$define_applic_identifier
*copyc dbp$define_debug_symbol_tables
*copyc dbp$define_line_address_table
*copyc dbp$define_module
*copyc dbp$define_section
*copyc dbp$define_supplemental_dtables
*copyc dbp$module_table_address
*copyc dbp$terminate_module
*copyc i#build_adaptable_array_ptr
*copyc i#build_adaptable_seq_pointer
*copyc lop$add_local_block_id
*copyc lop$add_text_embedded_libraries
*copyc lop$copy_binding_section_text
*copyc lop$define_entry_point
*copyc lop$define_formal_parameters
*copyc lop$find_common_block_definiton
*copyc lop$generate_load_map_text
*copyc lop$link_actual_parameters
*copyc lop$link_external
*copyc lop$open_library_as_predefined
*copyc lop$report_error
*copyc lop$report_secondary_error
*copyc lop$reserve_storage
*copyc lop$store_intercept_linkage
*copyc lop$store_linkage
*copyc mmp$advise_out
*copyc mmp$reserve_segment_number
*copyc mmp$set_access_selections
*copyc osp$generate_message
*copyc osp$set_status_abnormal
*copyc osp$set_status_from_condition
*copyc pmp$cause_condition
*copyc pmp$continue_to_cause
*copyc pmp$establish_condition_handler
*copyc pmp$exit
*copyc pmp$get_loaded_rings
*copyc pmp$get_mainframe_attributes
*copyc pmp$position_object_library
*copyc pmp$zero_out_table
*copyc syp$advised_move_bytes

*copyc lov$apd_load
*copyc lov$loader_options
*copyc lov$loi$nil
*copyc lov$secondary_status
*copyc osv$page_size
*copyc osv$task_private_heap
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  VAR
    lov$deferred_common_blocks: [oss$task_private, XDCL] ^lot$deferred_common_blocks := NIL,
    lov$deferred_entry_points: [oss$task_private, XDCL] ^lot$deferred_entry_points := NIL,
    lov$read_write_cache_bypass: [oss$task_shared, XDCL, #GATE] boolean := FALSE,
    lov$stack_cache_bypass: [oss$task_shared, XDCL, #GATE] boolean := FALSE,
    stack_segment_attributes: [STATIC] lot$segment_attributes :=
          [[ * , osc$non_executable, osc$read_uncontrolled, osc$write_uncontrolled], * , * ,
          [FALSE, FALSE, 0], TRUE, FALSE, FALSE, FALSE],
    vector_attributes: [STATIC] array [1 .. 2] of pmt$mainframe_attribute :=
          [[pmc$mak_unknown_attribute], [pmc$mak_unknown_attribute]];

?? OLDTITLE ??
?? NEWTITLE := '[XDCL] lop$load_module', EJECT ??

  PROCEDURE [XDCL] lop$load_module
    (    module_ring_attributes: lot$module_ring_attributes;
         file_attributes: lot$load_file_attributes;
         control_options {control} : lot$control_options;
     VAR load_file {input_output} : lot$load_file;
     VAR transfer_descriptor: lot$external_descriptor;
     VAR debug_symbol_table_present {control} : boolean;
     VAR module_structure_error {control} : boolean);

{  PURPOSE:
{    This procedure is a transaction center which obtains object text records from the load
{    file and routes each record to an appropriate procedure for processing.  It is responsible for
{    enforcing conventions on the order of object text records and the structure (but not content)
{    of each object text record.

    VAR {record templates}
      record_descriptor: ^llt$object_text_descriptor,
      identification: ^llt$identification,
      text_embedded_libraries: ^llt$libraries,
      section_definition: ^llt$section_definition,
      text: ^llt$text,
      replication: ^llt$replication,
      bit_string_insertion: ^llt$bit_string_insertion,
      entry_definition: ^llt$entry_definition,
      deferred_entry_points: ^llt$deferred_entry_points,
      deferred_common_blocks: ^llt$deferred_common_blocks,
      application_identifier: ^llt$application_identifier,
      external_linkage: ^llt$external_linkage,
      address_formulation: ^llt$address_formulation,
      transfer_symbol: ^llt$transfer_symbol,
      obsolete_formal_parameters: ^llt$obsolete_formal_parameters,
      formal_parameters: ^llt$formal_parameters,
      actual_parameters: ^llt$actual_parameters,
      binding_template: ^llt$binding_template,
      relocation: ^llt$relocation,
      ppu_absolute: ^llt$ppu_absolute,
      obsolete_line_address_table: ^llt$obsolete_line_address_table,
      line_address_table: ^llt$line_address_table,
      cybil_debug_symbol_table: ^llt$debug_table_fragment,
      debug_symbol_table: ^llt$symbol_table,
      supplemental_debug_tables: ^llt$supplemental_debug_tables,
      obs_segment_definition: ^llt$obsolete_segment_definition,
      segment_definition: ^llt$segment_definition;

    VAR
      duplicate_entry_point: boolean,
      i: llt$section_ordinal,
      greatest_section_ordinal: llt$section_ordinal,
      allocated_sections: ^lot$allocated_sections,
      attributes: lot$module_attributes,
      module_descriptor: lot$module_descriptor,
      allotted_section_address: ^cell,
      reset_value: ^SEQ ( * ),
      valid_file_position: boolean,
      initial_ptr: ^cell,
      abort_status: ^ost$status,
      strng: string (30),
      lngth: integer;


    CONST
      c$segment_predefined = TRUE;

?? EJECT ??

    module_descriptor.attributes.loaded_ring := module_ring_attributes.loaded_ring;
    module_descriptor.attributes.call_bracket := module_ring_attributes.call_bracket;
    module_descriptor.attributes.binding_section_address := loc$nil;
    IF file_attributes.key_lock.global THEN
      module_descriptor.attributes.global_key_lock := file_attributes.key_lock.value;
    ELSE
      module_descriptor.attributes.global_key_lock := loc$master_key_no_lock;
    IFEND;
    module_structure_error := FALSE;
    debug_symbol_table_present := FALSE;
    mmp$set_access_selections (load_file, mmc$as_sequential, lov$secondary_status);
    IF NOT lov$secondary_status.normal THEN
      lov$secondary_status.normal := TRUE;
      lop$report_error (lov$secondary_status.condition, '', '', 0);
    IFEND;

  /eof_shell/
    BEGIN
      NEXT record_descriptor IN load_file;
      IF (record_descriptor = NIL) OR (record_descriptor^.kind <> llc$identification) THEN
        lop$report_error (lle$identification_expected, file_attributes.name, '', #OFFSET (record_descriptor));
        module_structure_error := TRUE;
        RETURN
      IFEND;
      NEXT identification IN load_file;
      IF identification = NIL THEN
        EXIT /eof_shell/
      IFEND;
      save_ptr_for_advise_out (identification, initial_ptr);
      identify_module (identification, control_options, ^file_attributes, module_descriptor,
            greatest_section_ordinal, module_structure_error);
      IF module_structure_error THEN
        RETURN
      IFEND;
      PUSH allocated_sections: [0 .. greatest_section_ordinal];
      FOR i := 0 TO greatest_section_ordinal DO
        allocated_sections^ [i].address := loc$nil;
      FOREND;

    /fixer_value_shell/
      BEGIN

      /interpretive_record_processing/
        WHILE TRUE DO
          NEXT record_descriptor IN load_file;
          IF record_descriptor = NIL THEN
            EXIT /eof_shell/
          IFEND;
          CASE record_descriptor^.kind OF
          = llc$libraries =
            IF (record_descriptor^.number_of_libraries = 0) OR
                  (record_descriptor^.number_of_libraries > llc$max_libraries) THEN
              EXIT /fixer_value_shell/
            IFEND;
            NEXT text_embedded_libraries: [1 .. record_descriptor^.number_of_libraries] IN load_file;
            IF text_embedded_libraries = NIL THEN
              EXIT /eof_shell/
            IFEND;
            lop$add_text_embedded_libraries (text_embedded_libraries);

          = llc$section_definition, llc$unallocated_common_block =
            NEXT section_definition IN load_file;
            IF section_definition = NIL THEN
              EXIT /eof_shell/
            IFEND;
            define_section (section_definition, ^module_descriptor, ^file_attributes, FALSE, NIL,
                  control_options, (NOT c$segment_predefined), 0, loc$no_shadow, 0,
                  (record_descriptor^.kind = llc$unallocated_common_block), allocated_sections^);

            IF section_definition^.kind = llc$binding_section THEN
              module_descriptor.attributes.binding_section_address :=
                    allocated_sections^ [section_definition^.section_ordinal].address;
            IFEND;

          = llc$allotted_section_definition =
            NEXT section_definition IN load_file;
            IF section_definition = NIL THEN
              EXIT /eof_shell/;
            IFEND;
            reset_value := load_file;
            pmp$position_object_library (load_file, record_descriptor^.allotted_section, valid_file_position);
            IF valid_file_position THEN
              NEXT allotted_section_address IN load_file;
              load_file := reset_value;
            IFEND;
            IF NOT valid_file_position OR (allotted_section_address = NIL) THEN
              lop$report_error (lle$bad_allotted_section_ptr, identification^.name, '',
                    #OFFSET (record_descriptor));
              RETURN;
            IFEND;
            define_section (section_definition, ^module_descriptor, ^file_attributes, TRUE,
                  allotted_section_address, control_options, (NOT c$segment_predefined), 0, loc$no_shadow, 0,
                  FALSE, allocated_sections^);

          = llc$segment_definition =
            NEXT segment_definition IN load_file;
            IF segment_definition = NIL THEN
              EXIT /eof_shell/
            IFEND;

            define_section (^segment_definition^.section_definition, ^module_descriptor, ^file_attributes,
                  FALSE, NIL, control_options, c$segment_predefined, segment_definition^.segment_number,
                  loc$no_shadow, segment_definition^.binding_section_offset, FALSE, allocated_sections^);

            IF segment_definition^.section_definition.kind = llc$binding_section THEN
              module_descriptor.attributes.binding_section_address :=
                    allocated_sections^ [segment_definition^.section_definition.section_ordinal].address;
            IFEND;

          = llc$allotted_segment_definition =
            NEXT segment_definition IN load_file;
            IF segment_definition = NIL THEN
              EXIT /eof_shell/;
            IFEND;

            reset_value := load_file;
            pmp$position_object_library (load_file, record_descriptor^.allotted_segment, valid_file_position);
            IF valid_file_position THEN
              NEXT allotted_section_address IN load_file;
              load_file := reset_value;
            IFEND;
            IF NOT valid_file_position OR (allotted_section_address = NIL) THEN
              lop$report_error (lle$bad_allotted_section_ptr, identification^.name, '',
                    #OFFSET (record_descriptor));
              RETURN;
            IFEND;

            define_section (^segment_definition^.section_definition, ^module_descriptor, ^file_attributes,
                  TRUE, allotted_section_address, control_options, c$segment_predefined,
                  segment_definition^.segment_number, record_descriptor^.allotted_segment_length,
                  segment_definition^.binding_section_offset, FALSE, allocated_sections^);

          = llc$obsolete_segment_definition =
            NEXT obs_segment_definition IN load_file;
            IF obs_segment_definition = NIL THEN
              EXIT /eof_shell/
            IFEND;

            define_section (^obs_segment_definition^.section_definition, ^module_descriptor, ^file_attributes,
                  FALSE, NIL, control_options, c$segment_predefined, obs_segment_definition^.segment_number,
                  loc$no_shadow, 0, FALSE, allocated_sections^);

            IF obs_segment_definition^.section_definition.kind = llc$binding_section THEN
              module_descriptor.attributes.binding_section_address :=
                    allocated_sections^ [obs_segment_definition^.section_definition.section_ordinal].address;
            IFEND;

          = llc$obsolete_allotted_seg_def =
            NEXT obs_segment_definition IN load_file;
            IF obs_segment_definition = NIL THEN
              EXIT /eof_shell/;
            IFEND;

            reset_value := load_file;
            pmp$position_object_library (load_file, record_descriptor^.allotted_segment, valid_file_position);
            IF valid_file_position THEN
              NEXT allotted_section_address IN load_file;
              load_file := reset_value;
            IFEND;
            IF NOT valid_file_position OR (allotted_section_address = NIL) THEN
              lop$report_error (lle$bad_allotted_section_ptr, identification^.name, '',
                    #OFFSET (record_descriptor));
              RETURN;
            IFEND;

            define_section (^obs_segment_definition^.section_definition, ^module_descriptor, ^file_attributes,
                  TRUE, allotted_section_address, control_options, c$segment_predefined,
                  obs_segment_definition^.segment_number, record_descriptor^.allotted_segment_length, 0,
                  FALSE, allocated_sections^);

          = llc$application_identifier =
            NEXT application_identifier IN load_file;
            IF application_identifier = NIL THEN
              EXIT /eof_shell/
            IFEND;
            dbp$define_applic_identifier (application_identifier, lov$secondary_status);
            IF NOT lov$secondary_status.normal THEN
              lov$secondary_status.normal := TRUE;
              lop$report_secondary_error (lov$secondary_status);
            IFEND;

          = llc$transfer_symbol =
            NEXT transfer_symbol IN load_file;
            IF transfer_symbol = NIL THEN
              EXIT /eof_shell/
            IFEND;
            save_transfer_symbol (transfer_symbol, module_descriptor.attributes, control_options,
                  transfer_descriptor);
            mmp$set_access_selections (load_file, mmc$as_random, lov$secondary_status);
            IF NOT lov$secondary_status.normal THEN
              lov$secondary_status.normal := TRUE;
              lop$report_error (lov$secondary_status.condition, '', '', 0);
            IFEND;
            advise_out_load_module (transfer_symbol, initial_ptr);
            EXIT /interpretive_record_processing/;
          = llc$entry_definition =
            NEXT entry_definition IN load_file;
            IF entry_definition = NIL THEN
              EXIT /eof_shell/
            IFEND;
            lop$define_entry_point (entry_definition, ^module_descriptor, allocated_sections, control_options,
                  file_attributes.load_file_number, duplicate_entry_point);
          = llc$external_linkage =
            IF (record_descriptor^.number_of_ext_items = 0) OR
                  (record_descriptor^.number_of_ext_items > llc$max_ext_items) THEN
              EXIT /fixer_value_shell/
            IFEND;
            NEXT external_linkage: [1 .. record_descriptor^.number_of_ext_items] IN load_file;
            IF external_linkage = NIL THEN
              EXIT /eof_shell/
            IFEND;
            lop$link_external (external_linkage, allocated_sections, ^module_descriptor, control_options);
          = llc$address_formulation =
            IF (record_descriptor^.number_of_adr_items = 0) OR
                  (record_descriptor^.number_of_adr_items > llc$max_adr_items) THEN
              EXIT /fixer_value_shell/
            IFEND;
            NEXT address_formulation: [1 .. record_descriptor^.number_of_adr_items] IN load_file;
            IF address_formulation = NIL THEN
              EXIT /eof_shell/
            IFEND;
            form_addresses (address_formulation, module_descriptor.attributes, allocated_sections);
          = llc$text =
            IF (record_descriptor^.number_of_bytes = 0) OR (record_descriptor^.number_of_bytes >
                  osc$max_segment_length) THEN
              EXIT /fixer_value_shell/
            IFEND;
            NEXT text: [1 .. record_descriptor^.number_of_bytes] IN load_file;
            IF text = NIL THEN
              EXIT /eof_shell/
            IFEND;
            copy_text (text, allocated_sections);
          = llc$replication =
            IF (record_descriptor^.number_of_bytes = 0) OR (record_descriptor^.number_of_bytes >
                  osc$max_segment_length) THEN
              EXIT /fixer_value_shell/
            IFEND;
            NEXT replication: [1 .. record_descriptor^.number_of_bytes] IN load_file;
            IF replication = NIL THEN
              EXIT /eof_shell/
            IFEND;
            copy_replicated_text (replication, allocated_sections);
          = llc$bit_string_insertion =
            NEXT bit_string_insertion IN load_file;
            IF bit_string_insertion = NIL THEN
              EXIT /eof_shell/
            IFEND;
            insert_bit_string (bit_string_insertion, allocated_sections);
          = llc$obsolete_formal_parameters =
            IF (record_descriptor^.sequence_length = 0) OR (record_descriptor^.sequence_length >
                  osc$max_segment_length) THEN
              EXIT /fixer_value_shell/
            IFEND;
            NEXT obsolete_formal_parameters: [[REP record_descriptor^.sequence_length OF cell]] IN load_file;
            IF obsolete_formal_parameters = NIL THEN
              EXIT /eof_shell/
            IFEND;
          = llc$formal_parameters =
            IF (record_descriptor^.sequence_length = 0) OR (record_descriptor^.sequence_length >
                  osc$max_segment_length) THEN
              EXIT /fixer_value_shell/
            IFEND;
            NEXT formal_parameters: [[REP record_descriptor^.sequence_length OF cell]] IN load_file;
            IF formal_parameters = NIL THEN
              EXIT /eof_shell/
            IFEND;
            lop$define_formal_parameters (formal_parameters, attributes, ^module_descriptor,
                  allocated_sections, control_options);
          = llc$actual_parameters =
            IF (record_descriptor^.sequence_length = 0) OR (record_descriptor^.sequence_length >
                  osc$max_segment_length) THEN
              EXIT /fixer_value_shell/
            IFEND;
            NEXT actual_parameters: [[REP record_descriptor^.sequence_length OF cell]] IN load_file;
            IF actual_parameters = NIL THEN
              EXIT /eof_shell/
            IFEND;
            lop$link_actual_parameters (actual_parameters, ^module_descriptor, control_options);
          = llc$relocation =

{ This type of object text record contains information used only by the object library
{ generator and is simply ignored by the loader.

            IF (record_descriptor^.number_of_rel_items = 0) OR
                  (record_descriptor^.number_of_rel_items > llc$max_rel_items) THEN
              EXIT /fixer_value_shell/
            IFEND;
            NEXT relocation: [1 .. record_descriptor^.number_of_rel_items] IN load_file;
            IF relocation = NIL THEN
              EXIT /eof_shell/
            IFEND;
          = llc$binding_template =

{ This type of object text record contains information used only by the object library
{ generator and is simply ignored by the loader.

            NEXT binding_template IN load_file;
            IF binding_template = NIL THEN
              EXIT /eof_shell/
            IFEND;
          = llc$ppu_absolute =
            lop$report_error (lle$ppu_absolute_encountered, '', '', #OFFSET (record_descriptor));
            IF record_descriptor^.number_of_words > llc$max_ppu_size THEN
              EXIT /fixer_value_shell/
            IFEND;
            NEXT ppu_absolute: [0 .. record_descriptor^.number_of_words] IN load_file;
            IF ppu_absolute = NIL THEN
              EXIT /eof_shell/
            IFEND;
          = llc$identification =
            lop$report_error (lle$transfer_record_missing, module_descriptor.name, '', 0);
            RESET load_file TO record_descriptor;
            EXIT /interpretive_record_processing/;
          = llc$obsolete_line_table =
            IF (record_descriptor^.number_of_line_items = 0) THEN
              EXIT /fixer_value_shell/;
            IFEND;
            NEXT obsolete_line_address_table: [1 .. record_descriptor^.number_of_line_items] IN load_file;
            IF obsolete_line_address_table = NIL THEN
              EXIT /eof_shell/;
            IFEND;

          = llc$line_table =
            IF (record_descriptor^.number_of_line_items = 0) THEN
              EXIT /fixer_value_shell/;
            IFEND;

            NEXT line_address_table: [1 .. record_descriptor^.number_of_line_items] IN load_file;
            IF line_address_table = NIL THEN
              EXIT /eof_shell/;
            IFEND;

            IF (module_descriptor.attributes.loaded_ring >= control_options.debug_ring) THEN
              dbp$define_line_address_table (line_address_table, module_descriptor.attributes.loaded_ring,
                    lov$secondary_status);
              IF NOT lov$secondary_status.normal THEN
                lov$secondary_status.normal := TRUE;
                lop$report_secondary_error (lov$secondary_status);
              IFEND;

              debug_symbol_table_present := TRUE;
            IFEND;

          = llc$cybil_symbol_table_fragment =
            NEXT cybil_debug_symbol_table: [[REP record_descriptor^.sequence_length OF cell]] IN load_file;
            IF cybil_debug_symbol_table = NIL THEN
              EXIT /eof_shell/
            IFEND;

          = llc$symbol_table =
            NEXT debug_symbol_table: [[REP record_descriptor^.sequence_length OF cell]] IN load_file;
            IF debug_symbol_table = NIL THEN
              EXIT /eof_shell/;
            IFEND;
            IF (module_descriptor.attributes.loaded_ring >= control_options.debug_ring) THEN
              dbp$define_debug_symbol_tables (debug_symbol_table, module_descriptor.attributes.loaded_ring,
                    lov$secondary_status);
              IF NOT lov$secondary_status.normal THEN
                lov$secondary_status.normal := TRUE;
                lop$report_secondary_error (lov$secondary_status);
              IFEND;
              debug_symbol_table_present := TRUE;
            IFEND;

          = llc$supplemental_debug_tables =
            NEXT supplemental_debug_tables: [[REP record_descriptor^.sequence_length OF cell]] IN load_file;
            IF supplemental_debug_tables = NIL THEN
              EXIT /eof_shell/;
            IFEND;
            IF (module_descriptor.attributes.loaded_ring >= control_options.debug_ring) THEN
              dbp$define_supplemental_dtables (supplemental_debug_tables,
                    module_descriptor.attributes.loaded_ring, lov$secondary_status);
              IF NOT lov$secondary_status.normal THEN
                lov$secondary_status.normal := TRUE;
                lop$report_secondary_error (lov$secondary_status);
              IFEND;
              debug_symbol_table_present := TRUE;
            IFEND;

          = llc$deferred_entry_points =
            NEXT deferred_entry_points: [1 .. record_descriptor^.number_of_entry_points] IN load_file;
            IF deferred_entry_points = NIL THEN
              EXIT /eof_shell/
            IFEND;

            define_deferred_entry_points (deferred_entry_points);

          = llc$deferred_common_blocks =
            NEXT deferred_common_blocks: [1 .. record_descriptor^.number_of_common_blocks] IN load_file;
            IF deferred_common_blocks = NIL THEN
              EXIT /eof_shell/
            IFEND;

            define_deferred_common_blocks (deferred_common_blocks);

          ELSE
            lop$report_error (lle$unknown_record_kind, '', '', #OFFSET (record_descriptor));
            module_structure_error := TRUE;
            RETURN
          CASEND;
        WHILEND /interpretive_record_processing/;
        RETURN;
      END /fixer_value_shell/;
      lop$report_error (lle$bad_fixer_value, '', '', #OFFSET (record_descriptor));
      module_structure_error := TRUE;
      RETURN
    END /eof_shell/;
    lop$report_error (lle$premature_eof, file_attributes.name, '', #OFFSET (record_descriptor));

  PROCEND lop$load_module;
?? TITLE := '  [INLINE] copy_text', EJECT ??

  ?IF inline_procs = TRUE THEN

    PROCEDURE [INLINE] copy_text
  ?ELSE

    PROCEDURE copy_text
  ?IFEND
    (    text: ^llt$text;
         allocated_sections: ^lot$allocated_sections);

{  PURPOSE:
{    This procedure processes 'text' object text records. An array of bytes is copied to a specified
{    location in the loaded module.

    VAR
      target_address: lot$address,
      target_byte: ^array [1 .. * ] of 0 .. 255,
      any_code_base_ptrs_initialized: boolean,
      abort_status: ^ost$status;

    IF allocated_sections^ [text^.section_ordinal].kind = llc$binding_section THEN
      target_address := allocated_sections^ [text^.section_ordinal].address;
      target_address.offset := target_address.offset + text^.offset;
      lop$copy_binding_section_text (target_address, ^text^.byte, any_code_base_ptrs_initialized);
      IF (any_code_base_ptrs_initialized) THEN
        lop$report_error (lle$non_linkage_binding_data, 'text record', '', #OFFSET (text));
      IFEND;
    ELSE
      target_address := allocated_sections^ [text^.section_ordinal].address;
      target_address.offset := target_address.offset + text^.offset;
      i#build_adaptable_array_ptr (loc$loader_ring, target_address.segment, target_address.offset,
            UPPERBOUND (text^.byte), LOWERBOUND (text^.byte), 1, #LOC (target_byte));
      IF #SIZE (text^.byte) <= (2 * osv$page_size) THEN
        target_byte^ := text^.byte;
      ELSE
        syp$advised_move_bytes (#LOC (text^.byte), #LOC (target_byte^), #SIZE (text^.byte),
              lov$secondary_status);
        IF NOT lov$secondary_status.normal THEN
          lop$report_error (lle$unable_to_move_text, '', '', #OFFSET (target_byte));
          PUSH abort_status;
          pmp$cause_condition (loe$abort_load, NIL, abort_status^);
          pmp$exit (abort_status^);
        IFEND;
      IFEND;
    IFEND;
  PROCEND copy_text;
?? TITLE := '  [INLINE] copy_replicated_text', EJECT ??

  ?IF inline_procs = TRUE THEN

    PROCEDURE [INLINE] copy_replicated_text
  ?ELSE

    PROCEDURE copy_replicated_text
  ?IFEND
    (    replication: ^llt$replication;
         allocated_sections: ^lot$allocated_sections);

{  PURPOSE:
{    This procedure processes 'replication' object text records.  An array of bytes is copied
{    repetitively to specified locations in the loaded module.

    VAR
      i: 1 .. osc$max_segment_length,
      lower_limit: integer,
      target_address: lot$address,
      target_byte: ^array [1 .. * ] of 0 .. 255,
      upper_limit: integer,
      abort_status: ^ost$status;


    target_address := allocated_sections^ [replication^.section_ordinal].address;
    target_address.offset := target_address.offset + replication^.offset;
    lower_limit := LOWERBOUND (replication^.byte);
    upper_limit := UPPERBOUND (replication^.byte);
    FOR i := 1 TO replication^.count DO
      i#build_adaptable_array_ptr (loc$loader_ring, target_address.segment, target_address.offset,
            upper_limit, lower_limit, 1, #LOC (target_byte));
      IF #SIZE (replication^.byte) <= (2 * osv$page_size) THEN
        target_byte^ := replication^.byte;
      ELSE
        syp$advised_move_bytes (#LOC (replication^.byte), #LOC (target_byte^), #SIZE (replication^.byte),
              lov$secondary_status);
        IF NOT lov$secondary_status.normal THEN
          lop$report_error (lle$unable_to_move_text, '', '', #OFFSET (target_byte));
          PUSH abort_status;
          pmp$cause_condition (loe$abort_load, NIL, abort_status^);
          pmp$exit (abort_status^);
        IFEND;
      IFEND;
      target_address.offset := target_address.offset + replication^.increment;
    FOREND;
  PROCEND copy_replicated_text;
?? TITLE := '  [INLINE] insert_bit_string', EJECT ??

  ?IF inline_procs = TRUE THEN

    PROCEDURE [INLINE] insert_bit_string
  ?ELSE

    PROCEDURE insert_bit_string
  ?IFEND
    (    bit_string_insertion: ^llt$bit_string_insertion;
         allocated_sections: ^lot$allocated_sections);

{  PURPOSE:
{    This module processes 'bit_string_insertion' object text records.  An array of bits is copied
{    to a specified location in the loaded module.

    VAR
      target: ^packed array [0 .. 63] of 0 .. 1,
      i: 1 .. 63,
      target_address: lot$address,
      bytes_spanned: ost$segment_offset;

    target_address := allocated_sections^ [bit_string_insertion^.section_ordinal].address;
    target_address.offset := target_address.offset + bit_string_insertion^.offset;
    bytes_spanned := (bit_string_insertion^.bit_offset + bit_string_insertion^.bit_length + 7) DIV 8;
    target := #ADDRESS (loc$loader_ring, target_address.segment, target_address.offset);
    FOR i := 1 TO bit_string_insertion^.bit_length DO
      target^ [bit_string_insertion^.bit_offset + i - 1] := bit_string_insertion^.bit_string [i];
    FOREND;
  PROCEND insert_bit_string;
?? TITLE := '  [INLINE] form_addresses', EJECT ??

  ?IF inline_procs = TRUE THEN

    PROCEDURE [INLINE] form_addresses
  ?ELSE

    PROCEDURE form_addresses
  ?IFEND
    (    address_formulation: ^llt$address_formulation;
         attributes: lot$module_attributes;
         allocated_sections: ^lot$allocated_sections);

{  PURPOSE:
{    This procedure processes 'address_formulation' object text records.  A linkage (pointer) to some
{    address within the loaded module is generated at a specified location in the loaded module.

    TYPE
      valid_address_kinds = set of llt$internal_address_kind;

    VAR
      pseudo_entry_definition: lot$entry_definition,
      reference_details: lot$reference_details,
      destination_size: 0 .. 16,
      i: 1 .. llc$max_adr_items,
      j: llt$section_ordinal,
      binding_section_overwrite: boolean,
      declaration_mismatch: boolean,
      value_address_unaligned: boolean;


    reference_details.declaration_matching_required := FALSE;
    pseudo_entry_definition.attributes.global_lock := attributes.global_key_lock;
    pseudo_entry_definition.attributes.loaded_ring := attributes.loaded_ring;
    pseudo_entry_definition.attributes.call_bracket := attributes.loaded_ring;
    pseudo_entry_definition.attributes.binding_section_address := attributes.binding_section_address;
    pseudo_entry_definition.attributes.binding_section_address.ring := attributes.loaded_ring;
    IF (attributes.binding_section_address <> loc$nil) THEN
      pseudo_entry_definition.attributes.binding_section_address.offset :=
            pseudo_entry_definition.attributes.binding_section_address.offset +
            allocated_sections^ [address_formulation^.value_section].binding_section_offset;
    IFEND;
    pseudo_entry_definition.attributes.vmid := attributes.vmid;
    pseudo_entry_definition.attributes.address.ring := attributes.loaded_ring;
    pseudo_entry_definition.attributes.declaration_matching_required := FALSE;

  /form_one_address/
    FOR i := 1 TO UPPERBOUND (address_formulation^.item) DO
      CASE address_formulation^.item [i].kind OF
      = llc$external_proc =
        destination_size := 16;
      = llc$internal_proc =
        destination_size := 8;
      ELSE
        destination_size := 6;
      CASEND;
      reference_details.address := allocated_sections^ [address_formulation^.dest_section].address;
      reference_details.address.offset := reference_details.address.offset +
            address_formulation^.item [i].dest_offset;
      IF (allocated_sections^ [address_formulation^.dest_section].kind = llc$binding_section) THEN
        reference_details.binding_section_destination := TRUE;
      ELSE
        reference_details.binding_section_destination := FALSE;
      IFEND;
      reference_details.kind := address_formulation^.item [i].kind;
      pseudo_entry_definition.attributes.address := allocated_sections^ [address_formulation^.value_section].
            address;
      pseudo_entry_definition.attributes.address.offset :=
            pseudo_entry_definition.attributes.address.offset + address_formulation^.item [i].value_offset;
      IF lov$apd_flags.apd_load AND lov$apd_flags.target_text AND
            (reference_details.kind = llc$external_proc) THEN
        reference_details.in_target_text := TRUE;
        pseudo_entry_definition.attributes.in_target_text := TRUE;
        pseudo_entry_definition.attributes.block_id := allocated_sections^
              [address_formulation^.value_section].local_block_id;
        pseudo_entry_definition.attributes.instrumented := FALSE;
        lop$store_intercept_linkage (reference_details, osc$null_name, pseudo_entry_definition,
              binding_section_overwrite, declaration_mismatch, value_address_unaligned);
      ELSE
        lop$store_linkage (^reference_details, ^pseudo_entry_definition, binding_section_overwrite,
              declaration_mismatch, value_address_unaligned);
      IFEND;
      IF binding_section_overwrite THEN
        lop$report_error (lle$add_form_b_s_overwrite, '', '', #OFFSET (#LOC (address_formulation^.item [i])));
      IFEND;
      IF value_address_unaligned THEN
        lop$report_error (lle$value_address_unaligned, '', '',
              #OFFSET (#LOC (address_formulation^.item [i])));
      IFEND;
    FOREND /form_one_address/;
  PROCEND form_addresses;

?? TITLE := '  Advise out procedure', EJECT ??

  PROCEDURE [INLINE] save_ptr_for_advise_out
    (    id_ptr: ^llt$identification;
     VAR initial_ptr: ^cell);

    initial_ptr := id_ptr;

  PROCEND save_ptr_for_advise_out;




  PROCEDURE [INLINE] advise_out_load_module
    (    tra_ptr: ^llt$transfer_symbol;
         initial_ptr: ^cell);

    VAR
      first_value: 0 .. 0ffffffff(16),
      final_value: 0 .. 0ffffffff(16),
      difference: 0 .. 0ffffffff(16),
      local_status: ost$status;

    final_value := #OFFSET (tra_ptr);
    first_value := #OFFSET (initial_ptr);
    difference := final_value - first_value;

    IF difference >= (2 * osv$page_size) THEN
      mmp$advise_out (initial_ptr, difference, local_status);
      IF NOT local_status.normal THEN
        lop$report_error (local_status.condition, '', '', 0);
      IFEND;
    IFEND;

  PROCEND advise_out_load_module;
?? OLDTITLE ??
?? NEWTITLE := '[INLINE] identify_module', EJECT ??

{  PURPOSE:
{    This procedure processes the 'identification' object text record.  It extracts module
{    identification information from the object text record and causes generation of load map
{    output to identify the module being loaded and its protection environment.

  ?IF inline_procs = TRUE THEN

    PROCEDURE [INLINE] identify_module
  ?ELSE

    PROCEDURE identify_module
  ?IFEND
    (    identification: ^llt$identification;
         control_options {control} : lot$control_options;
         file_attributes: {input} ^lot$load_file_attributes;
     VAR module_descriptor {input_output} : lot$module_descriptor;
     VAR greatest_section_ordinal: llt$section_ordinal;
     VAR module_structure_error {control} : boolean);

    TYPE
      valid_languages = set of llt$module_generator;

    VAR
      abort_status: ^ost$status,
      generator_id: llt$module_generator,
      ignore_status: ost$status,
      load_map_data: lot$load_map_data;

    IF (pmc$block_map IN control_options.map) OR (pmc$entry_point_map IN control_options.map) THEN
      load_map_data.code := loc$lm_module_detail_1;
      load_map_data.module_name := identification^.name;
      IF file_attributes^.library_file THEN
        load_map_data.file_type := 'LIBRARY';
      ELSE
        load_map_data.file_type := '   FILE';
      IFEND;
      load_map_data.file_name := file_attributes^.name;
      load_map_data.loaded_ring := module_descriptor.attributes.loaded_ring;
      load_map_data.call_bracket := module_descriptor.attributes.call_bracket;
      load_map_data.module_global_key_lock := module_descriptor.attributes.global_key_lock;
      IF file_attributes^.key_lock.local THEN
        load_map_data.module_local_key_lock := file_attributes^.key_lock.value;
      ELSE
        load_map_data.module_local_key_lock := 0;
      IFEND;
      load_map_data.execute_privilege := file_attributes^.execute_privilege;
      lop$generate_load_map_text (load_map_data);
      IF pmc$block_map IN control_options.map THEN
        load_map_data.code := loc$lm_module_detail_2;
        CASE identification^.date_created.date_format OF
        = osc$mdy_date =
          load_map_data.date := identification^.date_created.mdy;
        = osc$iso_date =
          load_map_data.date := identification^.date_created.iso;
        = osc$ordinal_date =
          load_map_data.date := identification^.date_created.ordinal;
        = osc$dmy_date =
          load_map_data.date := identification^.date_created.dmy;
        ELSE
          load_map_data.date := '';
        CASEND;
        load_map_data.generator := identification^.generator_name_vers;
        load_map_data.commentary := identification^.commentary;
        lop$generate_load_map_text (load_map_data);
        IF (load_map_data.date = '') AND (identification^.date_created.date_format <> osc$month_date) THEN
          lop$report_error (lle$unknown_date_format, 'identification record', '', #OFFSET (identification));
        IFEND;
      IFEND
    IFEND;
    IF (identification^.object_text_version <> llc$object_text_version) THEN
      lop$report_error (lle$wrong_object_text_version, identification^.object_text_version,
            llc$object_text_version, 0);
      module_structure_error := TRUE;
    ELSEIF (identification^.kind <> llc$vector_virtual_state) AND
          (identification^.kind <> llc$vector_extended_state) AND
          (identification^.kind <> llc$mi_virtual_state) THEN
      lop$report_error (lle$module_wrong_kind, 'identification record', '', #OFFSET (identification));
      module_structure_error := TRUE;
    ELSEIF llc$nonexecutable IN identification^.attributes THEN
      lop$report_error (lle$module_nonexecutable, 'identification record', '', #OFFSET (identification));
      module_structure_error := TRUE;
    ELSE
      IF (identification^.kind = llc$vector_virtual_state) OR
            (identification^.kind = llc$vector_extended_state) THEN
        IF vector_attributes [1].key <> pmc$mak_vector_capability THEN
          vector_attributes [1].key := pmc$mak_vector_capability;
          vector_attributes [2].key := pmc$mak_vector_simulation;
          pmp$get_mainframe_attributes (vector_attributes, ignore_status);
        IFEND;
        IF (vector_attributes [1].vector_capability = pmc$no_vectors) AND
              (vector_attributes [2].vector_simulation = pmc$vectors_aborted) THEN
          lop$report_error (lle$model_wrong_kind, 'identification record', '', #OFFSET (identification));
          module_structure_error := TRUE;
          RETURN;
        IFEND;
      IFEND;
      module_descriptor.name := identification^.name;
      module_descriptor.attributes.vmid := osc$cyber_180_mode;
      module_descriptor.attributes.source_declaration_matching :=
            NOT (llc$object_cybil_checking IN identification^.attributes);
      greatest_section_ordinal := identification^.greatest_section_ordinal;
      IF identification^.generator_id IN -$valid_languages [] THEN
        generator_id := identification^.generator_id;
      ELSE
        generator_id := llc$unknown_generator;
        lop$report_error (lle$unknown_generator, '', '', #OFFSET (identification));
      IFEND;
      dbp$define_module (identification, generator_id, lov$secondary_status);
      IF NOT lov$secondary_status.normal THEN
        lov$secondary_status.normal := TRUE;
        lop$report_secondary_error (lov$secondary_status);
      IFEND;
    IFEND;
  PROCEND identify_module;
?? TITLE := '  define_section', EJECT ??

  PROCEDURE define_section
    (    section_definition: ^llt$section_definition;
         module_descriptor: {input} ^lot$module_descriptor;
         file_attributes: {input} ^lot$load_file_attributes;
         allotted: boolean;
         allotted_section_address: ^cell;
         control_options {control} : lot$control_options;
         segment_predefined: boolean;
         predefined_segment_number: ost$segment;
         shadow_length: ost$segment_length;
         binding_section_offset: llt$section_address_range;
         unallocated_common: boolean;
     VAR allocated_sections {input_output} : lot$allocated_sections);

{  PURPOSE:
{    This procedure processes the 'section_definition' object text record.  It is responsible
{    for allocating storage for the section within a segment which possesses appropriate
{    protection attributes.  It is also responsible for generating load map output identifying
{    the section and where it has been loaded.
{  NOTE:
{    Whenever a code section is defined, a stack segment is created if one does not already
{    exist for the ring into which the code section is loaded.

*copyc cyc$default_heap_name

*copyc lov$common_blocks
*copyc lov$apd_load
*copyc lov$binding_segment_attributes

    VAR
      previously_defined: boolean,
      inconsistent_definition: boolean,
      common_blocks_index: lot$common_blocks_index,
      shared_flag: boolean,
      segment_number: ^array [ * ] of ost$segment,
      segment_attributes: lot$segment_attributes,
      load_map_data: lot$load_map_data,
      debugger_section_descriptor: dbt$section_item,
      cybil_default_heap_size: ^ost$segment_length,
      existing_stack_segments: [STATIC] pmt$loadable_rings := $pmt$loadable_rings [],
      abort_status: ^ost$status;

?? NEWTITLE := '    [INLINE] verify_section_definition', EJECT ??

    ?IF inline_procs = TRUE THEN

      PROCEDURE [INLINE] verify_section_definition
    ?ELSE

      PROCEDURE verify_section_definition
    ?IFEND
      (    section_definition: ^llt$section_definition;
           allocated_sections: ^lot$allocated_sections;
       VAR inconsistent_definition {control} : boolean);

      TYPE
        valid_section_kinds = set of llt$section_kind;

      inconsistent_definition := FALSE;
      IF section_definition^.section_ordinal > UPPERBOUND (allocated_sections^) THEN
        lop$report_error (lle$invalid_section_ordinal, 'section definition record', '',
              #OFFSET (section_definition));
        inconsistent_definition := TRUE
      ELSE
        IF allocated_sections^ [section_definition^.section_ordinal].address <> loc$nil THEN
          lop$report_error (lle$duplicate_section_def, '', '', #OFFSET (section_definition));
          inconsistent_definition := TRUE;
        IFEND;
      IFEND;
      IF NOT (section_definition^.kind IN -$valid_section_kinds []) THEN
        lop$report_error (lle$unknown_section_kind, '', '', #OFFSET (section_definition));
        inconsistent_definition := TRUE;
      ELSE
        IF (section_definition^.kind = llc$binding_section) AND
              ((llc$write IN section_definition^.access_attributes) OR
              (llc$execute IN section_definition^.access_attributes)) THEN

{!  The following error is reported to load map too early.

          lop$report_error (lle$improper_b_s_attributes, '', '', #OFFSET (section_definition));
        IFEND;
        IF (llc$binding IN section_definition^.access_attributes) AND
              (section_definition^.kind <> llc$binding_section) THEN

{!  The following error is reported to load map too early.

          lop$report_error (lle$binding_attr_not_allowed, '', '', #OFFSET (section_definition));
        IFEND;
      IFEND;
      IF (llc$write IN section_definition^.access_attributes) AND
            (llc$execute IN section_definition^.access_attributes) THEN
        IF NOT (section_definition^.kind = llc$working_storage_section) OR
              (section_definition^.kind = llc$extensible_working_storage) THEN
          lop$report_error (lle$write_execute_section, '', '', #OFFSET (section_definition));
          inconsistent_definition := TRUE;
        IFEND;
      IFEND;
      IF section_definition^.allocation_alignment = 0 THEN
        lop$report_error (lle$section_alignment_zero, '', '', #OFFSET (section_definition));
        inconsistent_definition := TRUE;
      ELSEIF (section_definition^.kind = llc$binding_section) AND
            ((section_definition^.allocation_alignment MOD 8 + section_definition^.allocation_offset MOD 8) <>
            0) THEN
        lop$report_error (lle$binding_section_unaligned, '', '', #OFFSET (section_definition));
        inconsistent_definition := TRUE;
      IFEND;
    PROCEND verify_section_definition;
?? TITLE := '    [INLINE] create_stack_segment', EJECT ??

    ?IF inline_procs = TRUE THEN

      PROCEDURE [INLINE] create_stack_segment
    ?ELSE

      PROCEDURE create_stack_segment
    ?IFEND
      (    ring: ost$ring;
       VAR existing_stack_segments: pmt$loadable_rings);

*copyc lov$loader_options

      CONST
        stack_segment_alignment = 1,
        stack_segment_offset = 0,
        segment_not_predefined = FALSE;

      VAR
        unused_parameter: lot$address;

      IF existing_stack_segments = $pmt$loadable_rings [] THEN
        pmp$get_loaded_rings (existing_stack_segments);
        IF ring IN existing_stack_segments THEN
          RETURN
        IFEND;
      IFEND;
      existing_stack_segments := existing_stack_segments + $pmt$loadable_rings
            [module_descriptor^.attributes.loaded_ring];
      stack_segment_attributes.access_control.cache_bypass := lov$stack_cache_bypass;
      stack_segment_attributes.r1 := ring;
      stack_segment_attributes.r2 := ring;
      lop$reserve_storage (stack_segment_attributes, stack_segment_alignment, stack_segment_offset,
            segment_not_predefined, 0, loc$no_shadow_file, 0, lov$loader_options.maximum_stack_size,
            unused_parameter);
    PROCEND create_stack_segment;
?? OLDTITLE, EJECT ??

  /allocate_a_section/
    BEGIN
      verify_section_definition (section_definition, ^allocated_sections, inconsistent_definition);
      IF inconsistent_definition THEN
        RETURN
      IFEND;
      allocated_sections [section_definition^.section_ordinal].kind := section_definition^.kind;
      allocated_sections [section_definition^.section_ordinal].length := section_definition^.length;
      allocated_sections [section_definition^.section_ordinal].allotted := allotted;
      allocated_sections [section_definition^.section_ordinal].unallocated_common := FALSE;
      allocated_sections [section_definition^.section_ordinal].binding_section_offset :=
            binding_section_offset;
      allocated_sections [section_definition^.section_ordinal].segment_predefined := segment_predefined;
      IF (section_definition^.kind = llc$common_block) OR (section_definition^.kind =
            llc$extensible_common_block) THEN
        lop$find_common_block_definiton (section_definition, module_descriptor^.attributes,
              previously_defined, common_blocks_index, allocated_sections
              [section_definition^.section_ordinal].length);
        IF previously_defined THEN
          IF unallocated_common AND NOT lov$common_blocks^ [common_blocks_index].unallocated_common THEN
            lop$report_error (lle$common_attr_mismatch, section_definition^.name, '', 0);
          IFEND;

          allocated_sections [section_definition^.section_ordinal].
                address := lov$common_blocks^ [common_blocks_index].address;
          EXIT /allocate_a_section/
        IFEND;
      IFEND;
      IF section_definition^.kind = llc$binding_section THEN
        segment_attributes := binding_segment_attributes;
      ELSE
        segment_attributes.access_control.cache_bypass := FALSE;
        IF llc$execute IN section_definition^.access_attributes THEN
          segment_attributes.access_control.execute_privilege := file_attributes^.execute_privilege;
        ELSE
          segment_attributes.access_control.execute_privilege := osc$non_executable;
        IFEND;
        IF llc$read IN section_definition^.access_attributes THEN
          IF file_attributes^.key_lock.global OR file_attributes^.key_lock.local THEN
            segment_attributes.access_control.read_privilege := osc$read_key_lock_controlled;
          ELSE
            segment_attributes.access_control.read_privilege := osc$read_uncontrolled;
          IFEND;
        ELSE
          segment_attributes.access_control.read_privilege := osc$non_readable;
        IFEND;
        IF llc$write IN section_definition^.access_attributes THEN
          segment_attributes.access_control.cache_bypass := lov$read_write_cache_bypass;
          IF file_attributes^.key_lock.global OR file_attributes^.key_lock.local THEN
            segment_attributes.access_control.write_privilege := osc$write_key_lock_controlled;
          ELSE
            segment_attributes.access_control.write_privilege := osc$write_uncontrolled;
          IFEND;
        ELSE
          segment_attributes.access_control.write_privilege := osc$non_writable;
        IFEND;
        segment_attributes.r1 := module_descriptor^.attributes.loaded_ring;
        segment_attributes.r2 := module_descriptor^.attributes.loaded_ring;
        segment_attributes.key_lock := file_attributes^.key_lock;
        segment_attributes.stack := FALSE;
        segment_attributes.debug_segment := file_attributes^.debug_file;
        segment_attributes.apd_binding_segment := FALSE;
        segment_attributes.extensible := (section_definition^.kind = llc$extensible_working_storage) OR
              (section_definition^.kind = llc$extensible_common_block);
      IFEND;
      IF (allotted_section_address <> NIL) AND file_attributes^.library_file THEN
        IF NOT segment_predefined THEN
          allocated_sections [section_definition^.section_ordinal].address.ring :=
                module_descriptor^.attributes.loaded_ring;
          allocated_sections [section_definition^.section_ordinal].
                address.segment := #SEGMENT (allotted_section_address);
          allocated_sections [section_definition^.section_ordinal].
                address.offset := #OFFSET (allotted_section_address);
        ELSEIF (shadow_length = loc$no_shadow) THEN
          lop$open_library_as_predefined (file_attributes^.name, segment_attributes,
                predefined_segment_number);
          allocated_sections [section_definition^.section_ordinal].address.ring :=
                module_descriptor^.attributes.loaded_ring;
          allocated_sections [section_definition^.section_ordinal].address.segment :=
                predefined_segment_number;
          allocated_sections [section_definition^.section_ordinal].
                address.offset := #OFFSET (allotted_section_address);
        ELSE { allotted_segment with a shadow }
          lop$reserve_storage (segment_attributes, section_definition^.allocation_alignment,
                section_definition^.allocation_offset, segment_predefined, predefined_segment_number,
                allotted_section_address, shadow_length, allocated_sections
                [section_definition^.section_ordinal].length, allocated_sections
                [section_definition^.section_ordinal].address);

{ Turn off allotted for R/W so errors are not produced by addresses built in this section.

          allocated_sections [section_definition^.section_ordinal].allotted := FALSE;
        IFEND;
      ELSE
        IF NOT unallocated_common THEN
          lop$reserve_storage (segment_attributes, section_definition^.allocation_alignment,
                section_definition^.allocation_offset, segment_predefined, predefined_segment_number,
                loc$no_shadow_file, 0, allocated_sections [section_definition^.section_ordinal].length,
                allocated_sections [section_definition^.section_ordinal].address);
        ELSE
          shared_flag := FALSE;
          PUSH segment_number: [1 .. 1];
          mmp$reserve_segment_number (shared_flag, segment_number, lov$secondary_status);
          allocated_sections [section_definition^.section_ordinal].unallocated_common := TRUE;
          allocated_sections [section_definition^.section_ordinal].address.ring := segment_attributes.r1;
          allocated_sections [section_definition^.section_ordinal].address.segment := segment_number^ [1];
          allocated_sections [section_definition^.section_ordinal].address.offset := 0;
          lov$common_blocks^ [common_blocks_index].unallocated_common := TRUE;
          lov$common_blocks^ [common_blocks_index].unallocated_common_open := FALSE;
          lov$common_blocks^ [common_blocks_index].unallocated_common_segment := segment_number^ [1];
        IFEND;

        IF (section_definition^.kind = llc$common_block) OR
              (section_definition^.kind = llc$extensible_common_block) THEN
          IF NOT unallocated_common THEN
            lov$common_blocks^ [common_blocks_index].unallocated_common := FALSE;
          IFEND;
          lov$common_blocks^ [common_blocks_index].address :=
                allocated_sections [section_definition^.section_ordinal].address;
          lov$common_blocks^ [common_blocks_index].segment_access_control :=
                segment_attributes.access_control;
          IF ((section_definition^.kind = llc$extensible_common_block) AND
                (section_definition^.name = cyc$default_heap_name)) THEN
            cybil_default_heap_size := #ADDRESS (allocated_sections [section_definition^.section_ordinal].
                  address.ring, allocated_sections [section_definition^.section_ordinal].address.segment, 0);
            cybil_default_heap_size^ := allocated_sections [section_definition^.section_ordinal].length;
          IFEND;
        IFEND;
      IFEND;
      IF lov$apd_flags.apd_load AND lov$apd_flags.target_text AND
            (section_definition^.kind = llc$code_section) THEN
        lop$add_local_block_id (module_descriptor^.name, section_definition^.section_ordinal,
              section_definition^.name, allocated_sections [section_definition^.section_ordinal].
              local_block_id);
      IFEND;
      IF (section_definition^.kind = llc$code_section) AND
            NOT (module_descriptor^.attributes.loaded_ring IN existing_stack_segments) THEN
        create_stack_segment (module_descriptor^.attributes.loaded_ring, existing_stack_segments);
      IFEND;
    END /allocate_a_section/;
    IF pmc$block_map IN control_options.map THEN
      load_map_data.code := loc$lm_section_detail;
      load_map_data.section_kind := section_definition^.kind;
      load_map_data.section_address := allocated_sections [section_definition^.section_ordinal].address;
      load_map_data.section_access_attributes := section_definition^.access_attributes;
      load_map_data.section_length := section_definition^.length;
      load_map_data.section_name := section_definition^.name;
      lop$generate_load_map_text (load_map_data);
    IFEND;
    debugger_section_descriptor.kind := section_definition^.kind;
    debugger_section_descriptor.section_ordinal := section_definition^.section_ordinal;
    debugger_section_descriptor.address.ring := module_descriptor^.attributes.loaded_ring;
    debugger_section_descriptor.address.seg := allocated_sections [section_definition^.section_ordinal].
          address.segment;
    debugger_section_descriptor.address.offset := allocated_sections [section_definition^.section_ordinal].
          address.offset;
    debugger_section_descriptor.length := section_definition^.length;
    IF (section_definition^.kind = llc$code_section) AND file_attributes^.library_file THEN
      debugger_section_descriptor.segment_access_control.cache_bypass := FALSE;
      debugger_section_descriptor.segment_access_control.execute_privilege :=
            file_attributes^.execute_privilege;
      debugger_section_descriptor.segment_access_control.read_privilege := osc$read_uncontrolled;
      debugger_section_descriptor.segment_access_control.write_privilege := osc$non_writable;
    ELSEIF (section_definition^.kind = llc$common_block) OR
          (section_definition^.kind = llc$extensible_common_block) THEN
      debugger_section_descriptor.segment_access_control :=
            lov$common_blocks^ [common_blocks_index].segment_access_control;
    ELSE
      debugger_section_descriptor.segment_access_control := segment_attributes.access_control;
    IFEND;
    debugger_section_descriptor.ring.r1 := module_descriptor^.attributes.loaded_ring;
    debugger_section_descriptor.ring.r2 := module_descriptor^.attributes.loaded_ring;
    debugger_section_descriptor.ring.r3 := module_descriptor^.attributes.call_bracket;
    debugger_section_descriptor.key_lock := file_attributes^.key_lock;
    debugger_section_descriptor.name := section_definition^.name;
    dbp$define_section (debugger_section_descriptor, lov$secondary_status);
    IF NOT lov$secondary_status.normal THEN
      lov$secondary_status.normal := TRUE;
      lop$report_secondary_error (lov$secondary_status);
    IFEND;
  PROCEND define_section;
?? OLDTITLE ??
?? NEWTITLE := 'define_deferred_entry_points', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to add the deferred entry points
{   to a global table so they may be referenced if necessary during a
{   dynamic load.

  PROCEDURE define_deferred_entry_points
    (    deferred_entry_points: ^llt$deferred_entry_points);

    VAR
      entry_points: ^lot$deferred_entry_points,
      last_entry_points: ^lot$deferred_entry_points;


    ALLOCATE entry_points IN osv$task_private_heap^;
    entry_points^.deferred_entry_points := deferred_entry_points;
    entry_points^.link := NIL;

    IF lov$deferred_entry_points = NIL THEN
      lov$deferred_entry_points := entry_points;
    ELSE
      last_entry_points := lov$deferred_entry_points;
      WHILE last_entry_points^.link <> NIL DO
        last_entry_points := last_entry_points^.link;
      WHILEND;

      last_entry_points^.link := entry_points;
    IFEND;

  PROCEND define_deferred_entry_points;
?? OLDTITLE ??
?? NEWTITLE := 'define_deferred_common_blocks', EJECT ??

{ PURPOSE:
{   The purpose of this procedure is to add the deferred common blocks
{   to a global table so they may be referenced if necessary during a
{   dynamic load.

  PROCEDURE define_deferred_common_blocks
    (    deferred_common_blocks: ^llt$deferred_common_blocks);

    VAR
      common_blocks: ^lot$deferred_common_blocks,
      last_common_blocks: ^lot$deferred_common_blocks;


    ALLOCATE common_blocks IN osv$task_private_heap^;
    common_blocks^.deferred_common_blocks := deferred_common_blocks;
    common_blocks^.link := NIL;

    IF lov$deferred_common_blocks = NIL THEN
      lov$deferred_common_blocks := common_blocks;
    ELSE
      last_common_blocks := lov$deferred_common_blocks;
      WHILE last_common_blocks^.link <> NIL DO
        last_common_blocks := last_common_blocks^.link;
      WHILEND;

      last_common_blocks^.link := common_blocks;
    IFEND;

  PROCEND define_deferred_common_blocks;

?? TITLE := '  [INLINE] save_transfer_symbol', EJECT ??

  ?IF inline_procs = TRUE THEN

    PROCEDURE [INLINE] save_transfer_symbol
  ?ELSE

    PROCEDURE save_transfer_symbol
  ?IFEND
    (    transfer_symbol_record: ^llt$transfer_symbol;
         attributes: lot$module_attributes;
         control_options {control} : lot$control_options;
     VAR transfer_descriptor: lot$external_descriptor);

{  PURPOSE:
{    This procedure processes the 'transfer_symbol' object text record.  It simply records the
{    specified symbol, if any, as the most recently encountered transfer symbol.

    VAR
      abort_status: ^ost$status;

    IF transfer_symbol_record^.name <> osc$null_name THEN
      transfer_descriptor.name := transfer_symbol_record^.name;
      transfer_descriptor.reference_ring := attributes.loaded_ring;
      transfer_descriptor.global_key := attributes.global_key_lock;
    IFEND;
    dbp$terminate_module (lov$secondary_status);
    IF NOT lov$secondary_status.normal THEN
      lov$secondary_status.normal := TRUE;
      lop$report_secondary_error (lov$secondary_status);
    IFEND;
  PROCEND save_transfer_symbol;


?? TITLE := '  [XDCL] lop$reinitialize_module', EJECT ??

  PROCEDURE [XDCL] lop$reinitialize_module
    (    module_name: pmt$program_name;
     VAR status: ost$status);

*copyc loh$reinitialize_module

?? NEWTITLE := '    load_map_malfunction', EJECT ??

    PROCEDURE load_map_malfunction
      (    condition: pmt$condition;
           system_status: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);

{  PURPOSE:
{     The purpose of this condition handler is to terminate the task if
{     initialize or generate load map detects an unexpected abnormal status
{     from a NOS/VE request - the task exits with the unexpected status.

      VAR
        malfunction: ^ost$status;

      malfunction := system_status;
      pmp$exit (malfunction^);
    PROCEND load_map_malfunction;
?? TITLE := '    terminate_prematurely', EJECT ??

    PROCEDURE terminate_prematurely
      (    condition: pmt$condition;
           malfunction_status: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR condition_status: ost$status);

{   PURPOSE:
{      Circumstances may arise within the loader which cause premature termination
{      of the load process.  These circumstances are reported within the loader via
{      conditions.  This condition handler is responsible for fielding the condition;
{      reporting the abnormality; and prematurely terminating the load process.
{
{      The conditions and their meanings are:
{      1.  system conditions: the hardware detected a condition which is probably
{          caused by a loader coding error.  The specific condition is reported to
{          the output file and the task is terminated with the loader malfunctioned
{          exception code.  SEE: code for pmc$detected_uncorrected_err processing.
{      2.  segment access conditions:
{          a. mmc$sac_read_beyond_eoi, mmc$sac_segment_access_error,
{             mmc$sac_key_lock_violation, mmc$sac_ring_violation:
{             segment management detected an inconsistency which was probably
{             caused by a loader coding error.  The specific condition is reported
{             to the output file and the task is terminated with the loader
{             malfunctioned exception code.
{          b. mmc$sac_read_write_beyond_msl: user limits prevented the loader from
{             completing the load process.  The task is terminated with the
{             insufficient memory to load exception code.
{          c. mmc$sac_io_read_error: a hardware error was detected attempting to
{             read a page from a device.  The specific condition is reported to
{             the output file and the task is terminated with the premature load
{             termination exception code.
{      3.  user defined conditions:
{          a. cye$run_time_condition: the CYBIL run time checking detected an
{             error which was probably cause by a loader coding error.  The
{             specific condition is reported to the output file and the task is
{             terminated with loader malfunctioned exception code.
{          b. loe$abort_load: several constituent procedures of the loader detect
{             circumstances which prohibit continuation of the load process.  The
{             detecting procedure reports the circumstance to load map and causes
{             the loe$abort_load condition.  This condition handler terminates the
{             task with the premature load termination exception code.
{          c. loe$loader_malfunction: a constituent procedure of the loader
{             detected an inconsistency which probably was caused by a loader
{             coding error.  The detecting procedure causes the condition
{             pointing to a status variable which identifies the inconsistency.
{             This condition handler reports the identified inconsistency to
{             the output file and terminates the task with the loader malfunctioned
{             exception code.
{          d. loe$insufficient_memory: several constituent procedures of the
{             loader detect circumstances where there is not enough virtual memory
{             to complete the load process - this is generally a case of user
{             limit being exceeded.  The detecting procedure reports the shortage
{             to the load map and causes the condition.  This condition handler
{             terminates the task with insufficient memory to load exception code.
{          e. other: other user defined conditions will be continued and
{             otherwise ignored.
{          NOTE:  condition_status is used as ignore_status.
{

      VAR
        termination_descriptor: pmt$established_handler,
        cybil_error: ^ost$status,
        malfunction: ^ost$status,
        message: ost$status;

      CASE condition.selector OF
      = pmc$system_conditions =
        osp$set_status_from_condition ('LL', condition, save_area, message, condition_status);
        IF NOT (pmc$detected_uncorrected_err IN condition.system_conditions) THEN
          osp$generate_message (message, condition_status);
          osp$set_status_abnormal ('LL', lle$loader_malfunctioned, 'PROGRAM', status);
        ELSE
          status := message;
        IFEND;
      = mmc$segment_access_condition =
        CASE condition.segment_access_condition.identifier OF
        = mmc$sac_read_beyond_eoi, mmc$sac_segment_access_error, mmc$sac_key_lock_violation,
              mmc$sac_ring_violation =
          osp$set_status_from_condition ('LL', condition, save_area, message, condition_status);
          osp$generate_message (message, condition_status);
          osp$set_status_abnormal ('LL', lle$loader_malfunctioned, 'PROGRAM', status);
        = mmc$sac_read_write_beyond_msl =
          osp$set_status_abnormal ('LL', lle$insufficient_memory_to_load, '', status);
        = mmc$sac_io_read_error =
          osp$set_status_from_condition ('LL', condition, save_area, message, condition_status);
          osp$generate_message (message, condition_status);
          osp$set_status_abnormal ('LL', lle$premature_load_termination, 'Program', status);
        ELSE
          osp$set_status_from_condition ('LL', condition, save_area, message, condition_status);
          osp$generate_message (message, condition_status);
          osp$set_status_abnormal ('LL', lle$premature_load_termination, 'Program', status);
        CASEND;
      = pmc$user_defined_condition =
        IF (condition.user_condition_name = cye$run_time_condition) THEN
          cybil_error := malfunction_status;
          osp$generate_message (cybil_error^, condition_status);
          osp$set_status_abnormal ('LL', lle$loader_malfunctioned, 'PROGRAM', status);
        ELSEIF (condition.user_condition_name = loe$abort_load) THEN
          osp$set_status_abnormal ('LL', lle$premature_load_termination, 'Program', status);
        ELSEIF (condition.user_condition_name = loe$loader_malfunction) THEN
          malfunction := malfunction_status;
          osp$generate_message (malfunction^, condition_status);
          osp$set_status_abnormal ('LL', lle$loader_malfunctioned, 'PROGRAM', status);
        ELSEIF (condition.user_condition_name = loe$insufficient_memory) THEN
          osp$set_status_abnormal ('LL', lle$insufficient_memory_to_load, '', status);
        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          RETURN;
        IFEND;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
        RETURN;
      CASEND;
      EXIT lop$reinitialize_module;
    PROCEND terminate_prematurely;

?? OLDTITLE, EJECT ??

    CONST
      c$segment_predefined = TRUE;

    VAR
      map_malfunction: [STATIC, READ, oss$job_paged_literal] pmt$condition :=
            [pmc$user_defined_condition, loe$map_malfunction],
      termination_conditions: [STATIC, READ, oss$job_paged_literal] pmt$condition :=
            [pmc$condition_combination, $pmt$condition_combination
            [pmc$system_conditions, mmc$segment_access_condition, pmc$user_defined_condition]];

    VAR {record templates}
      actual_parameters: ^llt$actual_parameters,
      address_formulation: ^llt$address_formulation,
      application_identifier: ^llt$application_identifier,
      binding_template: ^llt$binding_template,
      bit_string_insertion: ^llt$bit_string_insertion,
      cybil_debug_symbol_table: ^llt$debug_table_fragment,
      debug_symbol_table: ^llt$symbol_table,
      entry_definition: ^llt$entry_definition,
      external_linkage: ^llt$external_linkage,
      formal_parameters: ^llt$formal_parameters,
      identification: ^llt$identification,
      line_address_table: ^llt$line_address_table,
      object_text_descriptor: ^llt$object_text_descriptor,
      obsolete_formal_parameters: ^llt$obsolete_formal_parameters,
      obsolete_line_address_table: ^llt$obsolete_line_address_table,
      obsolete_segment_definition: ^llt$obsolete_segment_definition,
      relocation: ^llt$relocation,
      replication: ^llt$replication,
      section_definition: ^llt$section_definition,
      segment_definition: ^llt$segment_definition,
      supplemental_debug_tables: ^llt$supplemental_debug_tables,
      text: ^llt$text,
      text_embedded_libraries: ^llt$libraries,
      transfer_symbol: ^llt$transfer_symbol;

    VAR
      allocated_sections: ^lot$allocated_sections,
      control_options: lot$control_options,
      i: llt$section_ordinal,
      idr: ^llt$identification,
      load_file: ^SEQ ( * ),
      malfunction_descriptor: pmt$established_handler,
      module_address_table_item: ^dbt$module_address_table_item,
      module_descriptor: lot$module_descriptor,
      premature_eof: boolean,
      termination_descriptor: pmt$established_handler,
      transfer_symbol_encountered: boolean;


?? EJECT ??


    status.normal := TRUE;

    pmp$establish_condition_handler (termination_conditions, ^terminate_prematurely, ^termination_descriptor,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF (lov$loader_options.map <> $pmt$load_map_options [pmc$no_load_map]) THEN
      pmp$establish_condition_handler (map_malfunction, ^load_map_malfunction, ^malfunction_descriptor,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    control_options.map := lov$loader_options.map;
    module_descriptor.name := module_name;
    module_descriptor.attributes.vmid := osc$cyber_180_mode;

    module_address_table_item := dbp$module_table_address ();

    WHILE (module_address_table_item <> NIL) AND (module_name <> module_address_table_item^.name) DO
      module_address_table_item := module_address_table_item^.next_module;
    WHILEND;

    IF module_address_table_item = NIL THEN
      lop$report_error (lle$module_not_previous_loaded, module_name, '', 0);
      RETURN;
    IFEND;

    IF module_address_table_item^.reinitialization_information <> NIL THEN
      idr := module_address_table_item^.reinitialization_information;
      i#build_adaptable_seq_pointer (#RING (idr), #SEGMENT (idr), #OFFSET (idr), (osc$max_segment_length - 1),
            0, load_file);
    ELSE
      lop$report_error (lle$no_reinit_info_for_module, module_name, '', 0);
      RETURN;
    IFEND;

    RESET load_file;
    NEXT identification IN load_file;
    IF identification = NIL THEN
      lop$report_error (lle$premature_eof_on_module, module_name, '', 0);
      RETURN;
    IFEND;

    PUSH allocated_sections: [0 .. identification^.greatest_section_ordinal];
    FOR i := 0 TO identification^.greatest_section_ordinal DO
      allocated_sections^ [i].address := loc$nil;
    FOREND;

    transfer_symbol_encountered := FALSE;

    WHILE NOT transfer_symbol_encountered DO
      NEXT object_text_descriptor IN load_file;
      CASE object_text_descriptor^.kind OF
      = llc$libraries =
        NEXT text_embedded_libraries: [1 .. object_text_descriptor^.number_of_libraries] IN load_file;
        premature_eof := text_embedded_libraries = NIL;

      = llc$section_definition, llc$unallocated_common_block =
        NEXT section_definition IN load_file;
        premature_eof := section_definition = NIL;

        IF NOT premature_eof THEN
          redefine_section (module_address_table_item, section_definition, ^module_descriptor, FALSE,
                (NOT c$segment_predefined), loc$no_shadow, 0, (object_text_descriptor^.kind =
                llc$unallocated_common_block), allocated_sections^);

          IF section_definition^.kind = llc$binding_section THEN
            module_descriptor.attributes.binding_section_address :=
                  allocated_sections^ [section_definition^.section_ordinal].address;
          IFEND;
        IFEND;

      = llc$allotted_section_definition =
        NEXT section_definition IN load_file;
        premature_eof := section_definition = NIL;

        IF NOT premature_eof THEN
          redefine_section (module_address_table_item, section_definition, ^module_descriptor, TRUE,
                (NOT c$segment_predefined), loc$no_shadow, 0, FALSE, allocated_sections^);
        IFEND;

      = llc$segment_definition =
        NEXT segment_definition IN load_file;
        premature_eof := segment_definition = NIL;

        IF NOT premature_eof THEN
          redefine_section (module_address_table_item, ^segment_definition^.section_definition,
                ^module_descriptor, FALSE, c$segment_predefined, loc$no_shadow,
                segment_definition^.binding_section_offset, FALSE, allocated_sections^);

          IF segment_definition^.section_definition.kind = llc$binding_section THEN
            module_descriptor.attributes.binding_section_address :=
                  allocated_sections^ [segment_definition^.section_definition.section_ordinal].address;
          IFEND;
        IFEND;

      = llc$allotted_segment_definition =
        NEXT segment_definition IN load_file;
        premature_eof := segment_definition = NIL;

        IF NOT premature_eof THEN
          redefine_section (module_address_table_item, ^segment_definition^.section_definition,
                ^module_descriptor, TRUE, c$segment_predefined,
                object_text_descriptor^.allotted_segment_length, segment_definition^.binding_section_offset,
                FALSE, allocated_sections^);
        IFEND;

      = llc$obsolete_segment_definition =
        NEXT obsolete_segment_definition IN load_file;
        premature_eof := obsolete_segment_definition = NIL;

        IF NOT premature_eof THEN
          redefine_section (module_address_table_item, ^obsolete_segment_definition^.section_definition,
                ^module_descriptor, FALSE, c$segment_predefined, loc$no_shadow, 0, FALSE,
                allocated_sections^);

          IF obsolete_segment_definition^.section_definition.kind = llc$binding_section THEN
            module_descriptor.attributes.binding_section_address :=
                  allocated_sections^ [obsolete_segment_definition^.section_definition.section_ordinal].
                  address;
          IFEND;
        IFEND;

      = llc$obsolete_allotted_seg_def =
        NEXT obsolete_segment_definition IN load_file;
        premature_eof := obsolete_segment_definition = NIL;

        IF NOT premature_eof THEN
          redefine_section (module_address_table_item, ^obsolete_segment_definition^.section_definition,
                ^module_descriptor, TRUE, c$segment_predefined,
                object_text_descriptor^.allotted_segment_length, 0, FALSE, allocated_sections^);
        IFEND;

      = llc$application_identifier =
        NEXT application_identifier IN load_file;
        premature_eof := application_identifier = NIL;

      = llc$transfer_symbol =
        NEXT transfer_symbol IN load_file;
        transfer_symbol_encountered := TRUE;
        mmp$advise_out (module_address_table_item^.reinitialization_information,
              (#OFFSET (load_file) - #OFFSET (module_address_table_item^.reinitialization_information)),
              status);

      = llc$entry_definition =
        NEXT entry_definition IN load_file;
        premature_eof := entry_definition = NIL;

      = llc$external_linkage =
        NEXT external_linkage: [1 .. object_text_descriptor^.number_of_ext_items] IN load_file;
        premature_eof := external_linkage = NIL;
        IF NOT premature_eof THEN
          link_external (external_linkage, module_address_table_item, allocated_sections, ^module_descriptor,
                control_options);
        IFEND;

      = llc$address_formulation =
        NEXT address_formulation: [1 .. object_text_descriptor^.number_of_adr_items] IN load_file;
        premature_eof := address_formulation = NIL;

        IF NOT premature_eof THEN

{ Reinitialize only writable sections that are not common blocks.

          IF (module_address_table_item^.section_item [address_formulation^.dest_section].
                segment_access_control.write_privilege <> osc$non_writable) AND
                (allocated_sections^ [address_formulation^.dest_section].kind <> llc$common_block) AND
                (allocated_sections^ [address_formulation^.dest_section].kind <>
                llc$extensible_common_block) THEN
            form_addresses (address_formulation, module_descriptor.attributes, allocated_sections);
          IFEND;
        IFEND;

      = llc$text =
        NEXT text: [1 .. object_text_descriptor^.number_of_bytes] IN load_file;
        premature_eof := text = NIL;

        IF NOT premature_eof THEN

{ Reinitialize only writable sections that are not common blocks.

          IF (module_address_table_item^.section_item [text^.section_ordinal].segment_access_control.
                write_privilege <> osc$non_writable) AND (allocated_sections^ [text^.section_ordinal].kind <>
                llc$common_block) AND (allocated_sections^ [text^.section_ordinal].kind <>
                llc$extensible_common_block) THEN
            copy_text (text, allocated_sections);
          IFEND;
        IFEND;

      = llc$replication =
        NEXT replication: [1 .. object_text_descriptor^.number_of_bytes] IN load_file;
        premature_eof := replication = NIL;

        IF NOT premature_eof THEN

{ Reinitialize only writable sections that are not common blocks.

          IF (module_address_table_item^.section_item [replication^.section_ordinal].segment_access_control.
                write_privilege <> osc$non_writable) AND (allocated_sections^ [replication^.section_ordinal].
                kind <> llc$common_block) AND (allocated_sections^ [replication^.section_ordinal].kind <>
                llc$extensible_common_block) THEN
            copy_replicated_text (replication, allocated_sections);
          IFEND;
        IFEND;

      = llc$bit_string_insertion =
        NEXT bit_string_insertion IN load_file;
        premature_eof := bit_string_insertion = NIL;

        IF NOT premature_eof THEN

{ Reinitialize only writable sections that are not common blocks.

          IF (module_address_table_item^.section_item [bit_string_insertion^.section_ordinal].
                segment_access_control.write_privilege <> osc$non_writable) AND
                (allocated_sections^ [bit_string_insertion^.section_ordinal].kind <> llc$common_block) AND
                (allocated_sections^ [bit_string_insertion^.section_ordinal].kind <>
                llc$extensible_common_block) THEN
            insert_bit_string (bit_string_insertion, allocated_sections);
          IFEND;
        IFEND;

      = llc$obsolete_formal_parameters =
        NEXT obsolete_formal_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN load_file;
        premature_eof := obsolete_formal_parameters = NIL;

      = llc$formal_parameters =
        NEXT formal_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN load_file;
        premature_eof := formal_parameters = NIL;

      = llc$actual_parameters =
        NEXT actual_parameters: [[REP object_text_descriptor^.sequence_length OF cell]] IN load_file;
        premature_eof := actual_parameters = NIL;

      = llc$relocation =

{ This type of object text record contains information used only by the object library
{ generator and is simply ignored by the loader.

        NEXT relocation: [1 .. object_text_descriptor^.number_of_rel_items] IN load_file;
        premature_eof := relocation = NIL;

      = llc$binding_template =

{ This type of object text record contains information used only by the object library
{ generator and is simply ignored by the loader.

        NEXT binding_template IN load_file;
        premature_eof := binding_template = NIL;

      = llc$obsolete_line_table =
        NEXT obsolete_line_address_table: [1 .. object_text_descriptor^.number_of_line_items] IN load_file;
        premature_eof := obsolete_line_address_table = NIL;

      = llc$line_table =
        NEXT line_address_table: [1 .. object_text_descriptor^.number_of_line_items] IN load_file;
        premature_eof := line_address_table = NIL;

      = llc$cybil_symbol_table_fragment =
        NEXT cybil_debug_symbol_table: [[REP object_text_descriptor^.sequence_length OF cell]] IN load_file;
        premature_eof := cybil_debug_symbol_table = NIL;

      = llc$symbol_table =
        NEXT debug_symbol_table: [[REP object_text_descriptor^.sequence_length OF cell]] IN load_file;
        premature_eof := debug_symbol_table = NIL;

      = llc$supplemental_debug_tables =
        NEXT supplemental_debug_tables: [[REP object_text_descriptor^.sequence_length OF cell]] IN load_file;
        premature_eof := supplemental_debug_tables = NIL;

      ELSE
        lop$report_error (lle$unknown_record_kind, '', '', #OFFSET (object_text_descriptor));
        RETURN;

      CASEND;

      IF premature_eof THEN
        lop$report_error (lle$premature_eof_on_module, module_name, '', #OFFSET (object_text_descriptor));
        RETURN;

      IFEND;
    WHILEND;

  PROCEND lop$reinitialize_module;

?? TITLE := '  link_external', EJECT ??

  PROCEDURE link_external
    (    external_linkage: ^llt$external_linkage;
         module_address_table_item: ^dbt$module_address_table_item;
         allocated_sections: ^lot$allocated_sections;
         module_descriptor: ^lot$module_descriptor;
         control_options: lot$control_options);

{  PURPOSE:
{    This procedure calls LOP$LINK_EXTERNAL with any external
{    linkage items whose addresses are in a writable section.
{    IF the external linkage has more than one item, a new
{    external linkage record is built with only those items
{    that reference a writable section.

    VAR
      ext_linkage: ^llt$external_linkage,
      i: 1 .. llc$max_ext_items,
      link_index: ^array [1 .. * ] of 1 .. llc$max_ext_items,
      number_of_items: 1 .. llc$max_ext_items,
      number_of_items_to_link: 0 .. llc$max_ext_items;


    number_of_items := UPPERBOUND (external_linkage^.item);

    IF number_of_items = 1 THEN

{ Reinitialize only writable sections that are not common blocks.

      IF (module_address_table_item^.section_item [external_linkage^.item [1].section_ordinal].
            segment_access_control.write_privilege <> osc$non_writable) AND
            (allocated_sections^ [external_linkage^.item [1].section_ordinal].kind <> llc$common_block) AND
            (allocated_sections^ [external_linkage^.item [1].section_ordinal].kind <>
            llc$extensible_common_block) THEN
        lop$link_external (external_linkage, allocated_sections, module_descriptor, control_options);
      IFEND;
    ELSEIF number_of_items > 1 THEN
      number_of_items_to_link := 0;
      PUSH link_index: [1 .. number_of_items];
      FOR i := 1 TO number_of_items DO

{ Reinitialize only writable sections that are not common blocks.

        IF (module_address_table_item^.section_item [external_linkage^.item [i].section_ordinal].
              segment_access_control.write_privilege <> osc$non_writable) AND
              (allocated_sections^ [external_linkage^.item [i].section_ordinal].kind <> llc$common_block) AND
              (allocated_sections^ [external_linkage^.item [i].section_ordinal].kind <>
              llc$extensible_common_block) THEN
          number_of_items_to_link := number_of_items_to_link + 1;
          link_index^ [number_of_items_to_link] := i;
        IFEND;
      FOREND;
      IF number_of_items_to_link > 0 THEN
        PUSH ext_linkage: [1 .. number_of_items_to_link];
        ext_linkage^.name := external_linkage^.name;
        ext_linkage^.language := external_linkage^.language;
        ext_linkage^.declaration_matching_required := external_linkage^.declaration_matching_required;
        ext_linkage^.declaration_matching := external_linkage^.declaration_matching;
        FOR i := 1 TO number_of_items_to_link DO
          ext_linkage^.item [i] := external_linkage^.item [link_index^ [i]];
        FOREND;

        lop$link_external (ext_linkage, allocated_sections, module_descriptor, control_options);
      IFEND;
    IFEND;
  PROCEND link_external;

?? TITLE := '  redefine_section', EJECT ??

  PROCEDURE redefine_section
    (    module_address_table_item: ^dbt$module_address_table_item;
         section_definition: ^llt$section_definition;
         module_descriptor: ^lot$module_descriptor,
         allotted: boolean;
         segment_predefined: boolean;
         shadow_length: ost$segment_length;
         binding_section_offset: llt$section_address_range;
         unallocated_common: boolean;
     VAR allocated_sections {input_output} : lot$allocated_sections);

{  PURPOSE:
{    This procedure defines a section.  The address of the section, which
{    has already been loaded is obtained from the module address debug table.
{    If the section is writable, the space in the segment for the section is
{    initialized to the preset value.

    VAR
      space: ^cell;


    module_descriptor^.attributes.loaded_ring := module_address_table_item^.
          section_item [section_definition^.section_ordinal].address.ring;
    IF module_address_table_item^.section_item [section_definition^.section_ordinal].key_lock.global THEN
      module_descriptor^.attributes.global_key_lock := module_address_table_item^.
            section_item [section_definition^.section_ordinal].key_lock.value;
    ELSE
      module_descriptor^.attributes.global_key_lock := loc$master_key_no_lock;
    IFEND;

    allocated_sections [section_definition^.section_ordinal].kind := section_definition^.kind;
    allocated_sections [section_definition^.section_ordinal].length := section_definition^.length;
    allocated_sections [section_definition^.section_ordinal].allotted := allotted;
    allocated_sections [section_definition^.section_ordinal].unallocated_common := unallocated_common;
    allocated_sections [section_definition^.section_ordinal].binding_section_offset := binding_section_offset;
    allocated_sections [section_definition^.section_ordinal].segment_predefined := segment_predefined;

    allocated_sections [section_definition^.section_ordinal].address.ring :=
          module_address_table_item^.section_item [section_definition^.section_ordinal].address.ring;
    allocated_sections [section_definition^.section_ordinal].address.segment :=
          module_address_table_item^.section_item [section_definition^.section_ordinal].address.seg;
    allocated_sections [section_definition^.section_ordinal].address.offset :=
          module_address_table_item^.section_item [section_definition^.section_ordinal].address.offset;
    IF segment_predefined AND (shadow_length <> loc$no_shadow) THEN

{ Turn off allotted for R/W so errors are not produced by addresses built in this section.

      allocated_sections [section_definition^.section_ordinal].allotted := FALSE;
    IFEND;

{ Reinitialize only writable sections that are not common blocks.

    IF (section_definition^.kind <> llc$common_block) AND
          (section_definition^.kind <> llc$extensible_common_block) AND
          (llc$write IN section_definition^.access_attributes) THEN
      space := #ADDRESS (allocated_sections [section_definition^.section_ordinal].address.ring,
            allocated_sections [section_definition^.section_ordinal].
            address.segment, allocated_sections [section_definition^.section_ordinal].address.offset);
      reset_preset (space, allocated_sections [section_definition^.section_ordinal].length);
    IFEND;

  PROCEND redefine_section;

?? TITLE := '  reset_preset', EJECT ??


  PROCEDURE reset_preset
    (    space: ^cell;
         total_bytes: integer);

{  PURPOSE:
{    This procedure initializes an area specified by the parameters SPACE and
{    TOTAL_BYTES to the preset value.

    CONST
      word_size = 8;

    TYPE
      preset_converter = record
        case boolean of
        = TRUE =
          value: integer,
        = FALSE =
          bytes: array [1 .. word_size] of 0 .. 0ff(16),
        casend,
      recend;

    VAR
      byte: ^0 .. 0ff(16),
      fill: ^array [1 .. * ] of integer,
      i: ost$segment_length,
      leading_bytes: 0 .. word_size - 1,
      length: integer,
      number_of_words: ost$segment_length,
      preset: preset_converter,
      sequence_pointer: ^SEQ ( * ),
      trailing_bytes: 0 .. word_size;


    IF lov$loader_options.preset = 0 THEN
      pmp$zero_out_table (space, total_bytes);

    ELSE
      preset.value := lov$loader_options.preset;
      leading_bytes := #OFFSET (space) MOD word_size;
      length := total_bytes;
      i#build_adaptable_seq_pointer (#RING (space), #SEGMENT (space), #OFFSET (space),
            total_bytes, 0, sequence_pointer);

      RESET sequence_pointer;
      IF leading_bytes <> 0 THEN
        FOR i := leading_bytes + 1 TO word_size DO
          NEXT byte IN sequence_pointer;
          byte^ := preset.bytes [i];
        FOREND;
        length := length - word_size + leading_bytes;
      IFEND;

      number_of_words := length DIV word_size;
      trailing_bytes := length MOD word_size;

      NEXT fill: [1 .. number_of_words] IN sequence_pointer;
      FOR i := 1 TO number_of_words DO
        fill^ [i] := preset.value;
      FOREND;

      FOR i := 1 TO trailing_bytes DO
        NEXT byte IN sequence_pointer;
        byte^ := preset.bytes [i];
      FOREND;
    IFEND;
  PROCEND reset_preset;
MODEND lom$module_loader;
