?? RIGHT := 110 ??
?? TITLE := 'NOS/VE : Loader : Analyze program dynamics' ??
?? NEWTITLE := '  Global declarations' ??
MODULE lom$analyze_program_dynamics;
?? PUSH (LISTEXT := ON) ??
*copyc oss$job_paged_literal
*copyc oss$task_private
*copyc loe$abort_load
*copyc lle$load_map_diagnostics
*copyc lot$loader_type_definitions
*copyc osd$virtual_address
*copyc pmt$loader_seq_descriptor
?? POP ??
*copyc amp$get_file_attributes
*copyc amp$get_segment_pointer
*copyc fsp$close_file
*copyc fsp$open_file
*copyc lop$find_matching_entry_point
*copyc lop$report_error
*copyc lop$reserve_storage
*copyc lop$store_linkage
*copyc osp$generate_log_message
*copyc pmp$cause_condition
*copyc pmp$exit
*copyc pmp$initial_intercept_procedure
*copyc pmp$intercept_call_procedure
*copyc osv$task_private_heap
*copyc lov$secondary_status
?? EJECT ??

  TYPE
    pointer_to_apd_descriptor = record
      case 0 .. 1 of
      = 0 =
        apd_descriptor_ptr: ^pmt$loader_seq_descriptor,

      = 1 =
        apd_descriptor_address: lot$address,
      casend,
    recend;

  VAR
    lov$apd_flags: [oss$task_private, XDCL] record
      apd_load: boolean,
      target_text: boolean,
    recend := [FALSE, FALSE];

  TYPE
    apd_loader_information = record
      apd_files_opened: boolean,
      target_text: ^amt$local_file_name,
      loader_seq_file_name: ^amt$local_file_name,
      loader_seq_descriptor: ^pmt$loader_seq_descriptor,
      apd_descriptor: pointer_to_apd_descriptor,
      intercept_proc_bsp: lot$address,
      initial_intercept_proc_bsp: lot$address,
      pseudo_reference_details: ^lot$reference_details,
      pseudo_entry_definition: ^lot$entry_definition,
      intercept_proc_entry_definition: ^lot$entry_definition,
      intercept_reference_details: ^lot$reference_details,
      init_intercept_proc_entry_def: ^lot$entry_definition,
    recend;

  VAR
    allocation_length: [STATIC] ost$segment_length := 40,
    apd_binding_segment_attributes: [STATIC, READ, oss$job_paged_literal] lot$segment_attributes :=
          [[FALSE, osc$non_executable, osc$binding_segment, osc$non_writable], osc$tsrv_ring, osc$max_ring,
          [FALSE, FALSE, 0], FALSE, FALSE, FALSE, TRUE],
    apd_data: [oss$task_private, STATIC] ^apd_loader_information := NIL;

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

  PROCEDURE initialize_loader_seq
    (    loader_description: ^pmt$loader_description);



    VAR
      segment_pointer: amt$segment_pointer,
      seq_id: amt$file_identifier,
      ignore: boolean,
      interblock_references_hdr: ^pmt$interblock_references_hdr,
      current_attributes: array [1 .. 1] of amt$get_item,
      file_attachment: ^fst$attachment_options,
      attribute_validation: ^fst$file_cycle_attributes,
      status: ost$status,
      abort_status: ^ost$status;


    current_attributes [1].key := amc$ring_attributes;
    amp$get_file_attributes (loader_description^.mpe_loader_seq, current_attributes, ignore, ignore, ignore,
          lov$secondary_status);
    IF NOT lov$secondary_status.normal THEN
      lop$report_error (lle$unable_to_access_apd_file, loader_description^.mpe_loader_seq, '', 0);
      PUSH abort_status;
      pmp$cause_condition (loe$abort_load, NIL, abort_status^);
      pmp$exit (abort_status^);
    IFEND;

    PUSH file_attachment: [1 .. 1];
    file_attachment^ [1].selector := fsc$access_and_share_modes;
    file_attachment^ [1].access_modes.selector := fsc$specific_access_modes;
    file_attachment^ [1].access_modes.value := $fst$file_access_options
          [fsc$read, fsc$append, fsc$modify, fsc$shorten];
    file_attachment^ [1].share_modes.selector := fsc$determine_from_access_modes;

    PUSH attribute_validation: [1 .. 4];
    attribute_validation^ [1].selector := fsc$file_contents_and_processor;
    attribute_validation^ [1].file_contents := fsc$data;
    attribute_validation^ [1].file_processor := fsc$unknown_processor;
    attribute_validation^ [2].selector := fsc$file_organization;
    attribute_validation^ [2].file_organization := amc$sequential;
    attribute_validation^ [3].selector := fsc$record_type;
    attribute_validation^ [3].record_type := amc$undefined;
    attribute_validation^ [4].selector := fsc$ring_attributes;
    attribute_validation^ [4].ring_attributes := current_attributes [1].ring_attributes;

    fsp$open_file (loader_description^.mpe_loader_seq, amc$segment, file_attachment, NIL, NIL,
          attribute_validation, NIL, seq_id, lov$secondary_status);
    IF NOT lov$secondary_status.normal THEN
      lop$report_error (lle$unable_to_access_apd_file, loader_description^.mpe_loader_seq, '', 0);
      PUSH abort_status;
      pmp$cause_condition (loe$abort_load, NIL, abort_status^);
      pmp$exit (abort_status^);
    IFEND;

    amp$get_segment_pointer (seq_id, amc$sequence_pointer, segment_pointer, lov$secondary_status);
    IF NOT lov$secondary_status.normal THEN
      lop$report_error (lle$unable_to_access_apd_file, loader_description^.mpe_loader_seq, '', 0);
      PUSH abort_status;
      pmp$cause_condition (loe$abort_load, NIL, abort_status^);
      pmp$exit (abort_status^);
    IFEND;

    RESET segment_pointer.sequence_pointer;

    NEXT apd_data^.loader_seq_descriptor IN segment_pointer.sequence_pointer;
    IF apd_data^.loader_seq_descriptor = NIL THEN
      lop$report_error (lle$eof_encountered_on_apd_file, loader_description^.mpe_loader_seq, '', 0);
      PUSH abort_status;
      pmp$cause_condition (loe$abort_load, NIL, abort_status^);
      pmp$exit (abort_status^);
    IFEND;

    apd_data^.loader_seq_descriptor^.seq_ptr := segment_pointer.sequence_pointer;
    apd_data^.loader_seq_descriptor^.file_id := seq_id;
    apd_data^.loader_seq_descriptor^.mpe_aborted := FALSE;

    IF apd_data^.loader_seq_descriptor^.block_name_map_exists THEN
      NEXT apd_data^.loader_seq_descriptor^.remote_block_name_map:
            [0 .. apd_data^.loader_seq_descriptor^.remote_block_id] IN
            apd_data^.loader_seq_descriptor^.seq_ptr;
      IF apd_data^.loader_seq_descriptor^.remote_block_name_map = NIL THEN
        lop$report_error (lle$eof_encountered_on_apd_file, loader_description^.mpe_loader_seq, '', 0);
        PUSH abort_status;
        pmp$cause_condition (loe$abort_load, NIL, abort_status^);
        pmp$exit (abort_status^);
      IFEND;

      NEXT apd_data^.loader_seq_descriptor^.local_block_name_map:
            [0 .. apd_data^.loader_seq_descriptor^.local_block_id] IN
            apd_data^.loader_seq_descriptor^.seq_ptr;
      IF apd_data^.loader_seq_descriptor^.local_block_name_map = NIL THEN
        lop$report_error (lle$eof_encountered_on_apd_file, loader_description^.mpe_loader_seq, '', 0);
        PUSH abort_status;
        pmp$cause_condition (loe$abort_load, NIL, abort_status^);
        pmp$exit (abort_status^);
      IFEND;
    ELSE
      NEXT apd_data^.loader_seq_descriptor^.remote_block_name_map: [0 .. 0] IN
            apd_data^.loader_seq_descriptor^.seq_ptr;
      IF apd_data^.loader_seq_descriptor^.remote_block_name_map = NIL THEN
        lop$report_error (lle$eof_encountered_on_apd_file, loader_description^.mpe_loader_seq, '', 0);
        PUSH abort_status;
        pmp$cause_condition (loe$abort_load, NIL, abort_status^);
        pmp$exit (abort_status^);
      IFEND;

      NEXT apd_data^.loader_seq_descriptor^.local_block_name_map: [0 .. 0] IN
            apd_data^.loader_seq_descriptor^.seq_ptr;
      IF apd_data^.loader_seq_descriptor^.local_block_name_map = NIL THEN
        lop$report_error (lle$eof_encountered_on_apd_file, loader_description^.mpe_loader_seq, '', 0);
        PUSH abort_status;
        pmp$cause_condition (loe$abort_load, NIL, abort_status^);
        pmp$exit (abort_status^);
      IFEND;
    IFEND;

    apd_data^.loader_seq_descriptor^.remote_block_id := 0;
    apd_data^.loader_seq_descriptor^.local_block_id := 0;
    apd_data^.loader_seq_descriptor^.number_of_interblock_segments := 1;
    apd_data^.loader_seq_descriptor^.accumulated_intercept_time := 0;
    apd_data^.loader_seq_descriptor^.max_segment_length := osc$maximum_offset;

    ALLOCATE apd_data^.loader_seq_file_name IN osv$task_private_heap^;
    apd_data^.loader_seq_file_name^ := loader_description^.mpe_loader_seq;

    fsp$open_file (apd_data^.loader_seq_descriptor^.first_interblock_segment_name, amc$segment,
          file_attachment, NIL, NIL, attribute_validation, NIL, seq_id, lov$secondary_status);
    IF NOT lov$secondary_status.normal THEN
      lop$report_error (lle$unable_to_access_apd_file, apd_data^.loader_seq_descriptor^.
            first_interblock_segment_name, '', 0);
      PUSH abort_status;
      pmp$cause_condition (loe$abort_load, NIL, abort_status^);
      pmp$exit (abort_status^);
    IFEND;

    amp$get_segment_pointer (seq_id, amc$sequence_pointer, segment_pointer, lov$secondary_status);
    IF NOT lov$secondary_status.normal THEN
      lop$report_error (lle$unable_to_access_apd_file, apd_data^.loader_seq_descriptor^.
            first_interblock_segment_name, '', 0);
      PUSH abort_status;
      pmp$cause_condition (loe$abort_load, NIL, abort_status^);
      pmp$exit (abort_status^);
    IFEND;

    RESET segment_pointer.sequence_pointer;
    apd_data^.loader_seq_descriptor^.last_interblock_segment := segment_pointer.sequence_pointer;
    NEXT interblock_references_hdr IN apd_data^.loader_seq_descriptor^.last_interblock_segment;
    interblock_references_hdr^.file_id := seq_id;
    interblock_references_hdr^.number_of_interblock_references := 0;
    interblock_references_hdr^.next_segment_file_name := osc$null_name;
    apd_data^.apd_files_opened := TRUE;

  PROCEND initialize_loader_seq;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] lop$initialize_apd_processing' ??
?? EJECT ??

  PROCEDURE [XDCL] lop$initialize_apd_processing
    (    loader_description: ^pmt$loader_description);



    TYPE
      pointer_to_procedure = record
        case 0 .. 1 of
        = 0 =
          intercept_procedure: ^procedure,
        = 1 =
          proc_descriptor: procedure_descriptor
        casend,
      recend,

      procedure_descriptor = record
        binding_entry: ^binding_template,
        static_link: ^cell,
      recend;


    TYPE
      binding_template = record
        cbp: lot$cbp_template,
        filler: 0 .. 0ffff(16),
        bsp: lot$address,
      recend;


    VAR
      record_block_transfer: pointer_to_procedure,
      ptr_to_procedure_descriptor: procedure_descriptor;


    ALLOCATE apd_data IN osv$task_private_heap^;

    apd_data^.apd_files_opened := FALSE;
    lov$apd_flags.apd_load := TRUE;
    ALLOCATE apd_data^.target_text IN osv$task_private_heap^;
    apd_data^.target_text^ := loader_description^.target_text.local_file_name;

    initialize_loader_seq (loader_description);

    ALLOCATE apd_data^.pseudo_reference_details IN osv$task_private_heap^;
    apd_data^.pseudo_reference_details^.binding_section_destination := FALSE;
    apd_data^.pseudo_reference_details^.declaration_matching_required := FALSE;
    apd_data^.pseudo_reference_details^.kind := llc$address;
    ALLOCATE apd_data^.pseudo_entry_definition IN osv$task_private_heap^;
    apd_data^.pseudo_entry_definition^.attributes.declaration_matching_required := FALSE;

{ If declaration_matching_required is set to TRUE, one will need to initialize source_declaration_matching.

    ALLOCATE apd_data^.intercept_reference_details IN osv$task_private_heap^;
    apd_data^.intercept_reference_details^.binding_section_destination := FALSE;
    apd_data^.intercept_reference_details^.kind := llc$external_proc;

    record_block_transfer.intercept_procedure := ^pmp$intercept_call_procedure;
    ptr_to_procedure_descriptor := record_block_transfer.proc_descriptor;

    ALLOCATE apd_data^.intercept_proc_entry_definition IN osv$task_private_heap^;
    apd_data^.intercept_proc_entry_definition^.attributes.vmid :=
          ptr_to_procedure_descriptor.binding_entry^.cbp.vmid;
    apd_data^.intercept_proc_entry_definition^.attributes.call_bracket :=
          ptr_to_procedure_descriptor.binding_entry^.cbp.call_bracket;
    apd_data^.intercept_proc_entry_definition^.attributes.loaded_ring :=
          ptr_to_procedure_descriptor.binding_entry^.cbp.call_bracket;
    apd_data^.intercept_proc_entry_definition^.attributes.address :=
          ptr_to_procedure_descriptor.binding_entry^.cbp.address;
    apd_data^.intercept_proc_entry_definition^.attributes.declaration_matching_required := FALSE;

{ If declaration_matching_required is set to TRUE, one will need to initialize source_declaration_matching.

    apd_data^.intercept_proc_bsp := ptr_to_procedure_descriptor.binding_entry^.bsp;
    apd_data^.apd_descriptor.apd_descriptor_ptr := apd_data^.loader_seq_descriptor;

    record_block_transfer.intercept_procedure := ^pmp$initial_intercept_procedure;
    ptr_to_procedure_descriptor := record_block_transfer.proc_descriptor;

    ALLOCATE apd_data^.init_intercept_proc_entry_def IN osv$task_private_heap^;
    apd_data^.init_intercept_proc_entry_def^.attributes.vmid :=
          ptr_to_procedure_descriptor.binding_entry^.cbp.vmid;
    apd_data^.init_intercept_proc_entry_def^.attributes.call_bracket :=
          ptr_to_procedure_descriptor.binding_entry^.cbp.call_bracket;
    apd_data^.init_intercept_proc_entry_def^.attributes.loaded_ring :=
          ptr_to_procedure_descriptor.binding_entry^.cbp.call_bracket;
    apd_data^.init_intercept_proc_entry_def^.attributes.address :=
          ptr_to_procedure_descriptor.binding_entry^.cbp.address;
    apd_data^.init_intercept_proc_entry_def^.attributes.declaration_matching_required := FALSE;

{ If declaration_matching_required is set to TRUE, one will need to initialize source_declaration_matching.

    apd_data^.initial_intercept_proc_bsp := ptr_to_procedure_descriptor.binding_entry^.bsp;

  PROCEND lop$initialize_apd_processing;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] lop$check_for_target_text' ??
?? EJECT ??

  PROCEDURE [XDCL] lop$check_for_target_text
    (    file_name: amt$local_file_name);

    IF apd_data <> NIL THEN
      lov$apd_flags.target_text := file_name = apd_data^.target_text^;
    ELSE
      lov$apd_flags.target_text := FALSE;
    IFEND;

  PROCEND lop$check_for_target_text;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] lop$close_apd_processing_files', EJECT ??
*copy loh$close_apd_processing_files

  PROCEDURE [XDCL] lop$close_apd_processing_files;

    VAR
      ignore_status: ost$status,
      interblock_references_hdr: ^pmt$interblock_references_hdr,
      loader_seq_descriptor_p: ^pmt$loader_seq_descriptor;

    IF (apd_data <> NIL) AND apd_data^.apd_files_opened THEN
      loader_seq_descriptor_p := apd_data^.loader_seq_descriptor;
      RESET loader_seq_descriptor_p^.last_interblock_segment;
      NEXT interblock_references_hdr IN apd_data^.loader_seq_descriptor^.last_interblock_segment;
      IF interblock_references_hdr <> NIL THEN
        fsp$close_file (interblock_references_hdr^.file_id, ignore_status);
      IFEND;
      fsp$close_file (loader_seq_descriptor_p^.file_id, ignore_status);
      apd_data^.apd_files_opened := FALSE;
    IFEND;

  PROCEND lop$close_apd_processing_files;
?? EJECT ??
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] lop$gen_init_intercept_linkage' ??

  PROCEDURE [XDCL] lop$gen_init_intercept_linkage
    (    transfer_descriptor: lot$external_descriptor;
     VAR reference_details: lot$reference_details);



    VAR
      address_value_unaligned: boolean,
      apd_binding_section_address_1: lot$address,
      apd_binding_section_address_2: lot$address,
      binding_section_overwrite: boolean,
      declaration_mismatch: boolean,
      linkage_info: ^lot$linkage_name_lists,
      transfer_symbol_defined: boolean,
      transfer_symbol_definition: ^lot$entry_definition;


    IF transfer_descriptor.name = osc$null_name THEN
      RETURN;
    IFEND;

    lop$find_matching_entry_point (transfer_descriptor, transfer_symbol_defined, linkage_info,
          transfer_symbol_definition);

    IF transfer_symbol_defined THEN
      reference_details.binding_section_destination := FALSE;

      IF (NOT transfer_symbol_definition^.attributes.in_target_text) AND
            (NOT transfer_symbol_definition^.attributes.instrumented) THEN
        lop$add_remote_block_id (transfer_descriptor.name, transfer_symbol_definition^.attributes.block_id);
      IFEND;

      lop$reserve_storage (apd_binding_segment_attributes, 8, 0, FALSE, 0, loc$no_shadow_file, 0,
            allocation_length, apd_binding_section_address_1);
      apd_data^.init_intercept_proc_entry_def^.attributes.binding_section_address :=
            apd_binding_section_address_1;
      apd_data^.init_intercept_proc_entry_def^.attributes.address.ring :=
            transfer_symbol_definition^.attributes.address.ring;
      lop$store_linkage (^reference_details, apd_data^.init_intercept_proc_entry_def,
            binding_section_overwrite, declaration_mismatch, address_value_unaligned);
      apd_data^.intercept_reference_details^.address := apd_binding_section_address_1;

      IF transfer_symbol_definition^.attributes.instrumented THEN
        apd_data^.intercept_proc_entry_definition^.attributes.binding_section_address :=
              transfer_symbol_definition^.attributes.instrumented_callee_address;
      ELSE
        lop$reserve_storage (apd_binding_segment_attributes, 8, 0, FALSE, 0, loc$no_shadow_file, 0,
              allocation_length, apd_binding_section_address_2);
        apd_data^.intercept_proc_entry_definition^.attributes.binding_section_address :=
              apd_binding_section_address_2;
      IFEND;
      apd_data^.intercept_reference_details^.declaration_matching_required := FALSE;
      lop$store_linkage (apd_data^.intercept_reference_details, apd_data^.intercept_proc_entry_definition,
            binding_section_overwrite, declaration_mismatch, address_value_unaligned);
      IF address_value_unaligned THEN
        RETURN;
      IFEND;

      apd_data^.pseudo_entry_definition^.attributes.address := apd_data^.initial_intercept_proc_bsp;
      apd_binding_section_address_1.offset := apd_binding_section_address_1.offset + 18;
      apd_data^.pseudo_reference_details^.address := apd_binding_section_address_1;
      lop$store_linkage (apd_data^.pseudo_reference_details, apd_data^.pseudo_entry_definition,
            binding_section_overwrite, declaration_mismatch, address_value_unaligned);

      apd_data^.pseudo_entry_definition^.attributes.address.ring := 0;
      apd_data^.pseudo_entry_definition^.attributes.address.segment := 0;
      apd_data^.pseudo_entry_definition^.attributes.address.offset := 0;
      apd_binding_section_address_1.offset := apd_binding_section_address_1.offset + 8;
      apd_data^.pseudo_reference_details^.address := apd_binding_section_address_1;
      lop$store_linkage (apd_data^.pseudo_reference_details, apd_data^.pseudo_entry_definition,
            binding_section_overwrite, declaration_mismatch, address_value_unaligned);

      apd_data^.pseudo_entry_definition^.attributes.address :=
            apd_data^.apd_descriptor.apd_descriptor_address;
      apd_binding_section_address_1.offset := apd_binding_section_address_1.offset + 8;
      apd_data^.pseudo_reference_details^.address := apd_binding_section_address_1;
      lop$store_linkage (apd_data^.pseudo_reference_details, apd_data^.pseudo_entry_definition,
            binding_section_overwrite, declaration_mismatch, address_value_unaligned);

      IF NOT transfer_symbol_definition^.attributes.instrumented THEN
        apd_data^.intercept_reference_details^.address := apd_binding_section_address_2;
        apd_data^.intercept_reference_details^.declaration_matching_required :=
              reference_details.declaration_matching_required;
        apd_data^.intercept_reference_details^.declaration_matching := reference_details.declaration_matching;
        apd_data^.intercept_reference_details^.language := reference_details.language;
        lop$store_linkage (apd_data^.intercept_reference_details, transfer_symbol_definition,
              binding_section_overwrite, declaration_mismatch, address_value_unaligned);

        apd_data^.pseudo_entry_definition^.attributes.address := apd_data^.intercept_proc_bsp;
        apd_binding_section_address_2.offset := apd_binding_section_address_2.offset + 18;
        apd_data^.pseudo_reference_details^.address := apd_binding_section_address_2;
        lop$store_linkage (apd_data^.pseudo_reference_details, apd_data^.pseudo_entry_definition,
              binding_section_overwrite, declaration_mismatch, address_value_unaligned);

        apd_data^.pseudo_entry_definition^.attributes.address.ring := 0;
        IF transfer_symbol_definition^.attributes.block_id.local THEN
          apd_data^.pseudo_entry_definition^.attributes.address.segment := 1;
        ELSE
          apd_data^.pseudo_entry_definition^.attributes.address.segment := 0;
        IFEND;
        apd_data^.pseudo_entry_definition^.attributes.address.offset :=
              transfer_symbol_definition^.attributes.block_id.block_number;
        apd_binding_section_address_2.offset := apd_binding_section_address_2.offset + 8;
        apd_data^.pseudo_reference_details^.address := apd_binding_section_address_2;
        lop$store_linkage (apd_data^.pseudo_reference_details, apd_data^.pseudo_entry_definition,
              binding_section_overwrite, declaration_mismatch, address_value_unaligned);

        apd_data^.pseudo_entry_definition^.attributes.address :=
              apd_data^.apd_descriptor.apd_descriptor_address;
        apd_binding_section_address_2.offset := apd_binding_section_address_2.offset + 8;
        apd_data^.pseudo_reference_details^.address := apd_binding_section_address_2;
        lop$store_linkage (apd_data^.pseudo_reference_details, apd_data^.pseudo_entry_definition,
              binding_section_overwrite, declaration_mismatch, address_value_unaligned);
      IFEND;
    IFEND;

  PROCEND lop$gen_init_intercept_linkage;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] lop$get_loader_seq_descriptor', EJECT ??

  PROCEDURE [XDCL] lop$get_loader_seq_descriptor
    (VAR loader_seq_descriptor_p: ^pmt$loader_seq_descriptor);

    IF (apd_data <> NIL) AND apd_data^.apd_files_opened THEN
      loader_seq_descriptor_p := apd_data^.loader_seq_descriptor;
    ELSE
      loader_seq_descriptor_p := NIL;
    IFEND;

  PROCEND lop$get_loader_seq_descriptor;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] lop$store_intercept_linkage' ??
?? EJECT ??

  PROCEDURE [XDCL] lop$store_intercept_linkage
    (    reference_details: lot$reference_details;
         remote_block_name: pmt$program_name;
     VAR entry_definition: lot$entry_definition;
     VAR binding_section_overwrite: boolean;
     VAR declaration_mismatch: boolean;
     VAR address_value_unaligned: boolean);


    VAR
      apd_binding_section_address: lot$address;


    IF (NOT entry_definition.attributes.in_target_text) AND
          (NOT entry_definition.attributes.instrumented) THEN
      lop$add_remote_block_id (remote_block_name, entry_definition.attributes.block_id);
    IFEND;

    IF entry_definition.attributes.instrumented THEN
      apd_data^.intercept_proc_entry_definition^.attributes.binding_section_address :=
            entry_definition.attributes.instrumented_callee_address;
    ELSE
      lop$reserve_storage (apd_binding_segment_attributes, 8, 0, FALSE, 0, loc$no_shadow_file, 0,
            allocation_length, apd_binding_section_address);
      apd_data^.intercept_proc_entry_definition^.attributes.binding_section_address :=
            apd_binding_section_address;
    IFEND;

    lop$store_linkage (^reference_details, apd_data^.intercept_proc_entry_definition,
          binding_section_overwrite, declaration_mismatch, address_value_unaligned);
    IF binding_section_overwrite OR address_value_unaligned THEN
      RETURN;
    IFEND;

    IF NOT entry_definition.attributes.instrumented THEN
      apd_data^.intercept_reference_details^.address := apd_binding_section_address;
      apd_data^.intercept_reference_details^.declaration_matching_required :=
            reference_details.declaration_matching_required;
      apd_data^.intercept_reference_details^.declaration_matching := reference_details.declaration_matching;
      apd_data^.intercept_reference_details^.language := reference_details.language;
      lop$store_linkage (apd_data^.intercept_reference_details, ^entry_definition, binding_section_overwrite,
            declaration_mismatch, address_value_unaligned);

      entry_definition.attributes.instrumented := TRUE;
      entry_definition.attributes.instrumented_callee_address := apd_binding_section_address;

      apd_data^.pseudo_entry_definition^.attributes.address := apd_data^.intercept_proc_bsp;
      apd_binding_section_address.offset := apd_binding_section_address.offset + 18;
      apd_data^.pseudo_reference_details^.address := apd_binding_section_address;
      lop$store_linkage (apd_data^.pseudo_reference_details, apd_data^.pseudo_entry_definition,
            binding_section_overwrite, declaration_mismatch, address_value_unaligned);

      apd_data^.pseudo_entry_definition^.attributes.address.ring := 0;
      IF entry_definition.attributes.block_id.local THEN
        apd_data^.pseudo_entry_definition^.attributes.address.segment := 1;
      ELSE
        apd_data^.pseudo_entry_definition^.attributes.address.segment := 0;
      IFEND;
      apd_data^.pseudo_entry_definition^.attributes.address.offset :=
            entry_definition.attributes.block_id.block_number;
      apd_binding_section_address.offset := apd_binding_section_address.offset + 8;
      apd_data^.pseudo_reference_details^.address := apd_binding_section_address;
      lop$store_linkage (apd_data^.pseudo_reference_details, apd_data^.pseudo_entry_definition,
            binding_section_overwrite, declaration_mismatch, address_value_unaligned);

      apd_data^.pseudo_entry_definition^.attributes.address :=
            apd_data^.apd_descriptor.apd_descriptor_address;
      apd_binding_section_address.offset := apd_binding_section_address.offset + 8;
      apd_data^.pseudo_reference_details^.address := apd_binding_section_address;
      lop$store_linkage (apd_data^.pseudo_reference_details, apd_data^.pseudo_entry_definition,
            binding_section_overwrite, declaration_mismatch, address_value_unaligned);
    IFEND;

  PROCEND lop$store_intercept_linkage;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] lop$add_local_block_id' ??
?? EJECT ??

  PROCEDURE [XDCL] lop$add_local_block_id
    (    module_name: pmt$program_name;
         section_ordinal: llt$section_ordinal;
         procedure_name: pmt$program_name;
     VAR block_number: pmt$block_identifier);

    VAR
      abort_status: ^ost$status;


    apd_data^.loader_seq_descriptor^.local_block_id := apd_data^.loader_seq_descriptor^.local_block_id + 1;
    block_number.local := TRUE;

    IF apd_data^.loader_seq_descriptor^.block_name_map_exists THEN
      IF apd_data^.loader_seq_descriptor^.local_block_id <=
            UPPERBOUND (apd_data^.loader_seq_descriptor^.local_block_name_map^) THEN
        IF (apd_data^.loader_seq_descriptor^.local_block_name_map^
              [apd_data^.loader_seq_descriptor^.local_block_id].module_name = module_name) AND
              (apd_data^.loader_seq_descriptor^.local_block_name_map^
              [apd_data^.loader_seq_descriptor^.local_block_id].section_ordinal = section_ordinal) THEN
          block_number.block_number := apd_data^.loader_seq_descriptor^.local_block_id;
          RETURN;
        IFEND;
      IFEND;
      lop$report_error (lle$bad_local_block_name, procedure_name, '', 0);
      PUSH abort_status;
      pmp$cause_condition (loe$abort_load, NIL, abort_status^);
      pmp$exit (abort_status^);
    ELSE
      RESET apd_data^.loader_seq_descriptor^.seq_ptr TO apd_data^.loader_seq_descriptor^.local_block_name_map;

      NEXT apd_data^.loader_seq_descriptor^.local_block_name_map:
            [0 .. apd_data^.loader_seq_descriptor^.local_block_id] IN
            apd_data^.loader_seq_descriptor^.seq_ptr;
      IF apd_data^.loader_seq_descriptor^.local_block_name_map = NIL THEN
        lop$report_error (lle$eof_encountered_on_apd_file, apd_data^.loader_seq_file_name^, '', 0);
        PUSH abort_status;
        pmp$cause_condition (loe$abort_load, NIL, abort_status^);
        pmp$exit (abort_status^);
      IFEND;

      apd_data^.loader_seq_descriptor^.local_block_name_map^
            [apd_data^.loader_seq_descriptor^.local_block_id].procedure_name := procedure_name;
      apd_data^.loader_seq_descriptor^.local_block_name_map^
            [apd_data^.loader_seq_descriptor^.local_block_id].module_name := module_name;
      apd_data^.loader_seq_descriptor^.local_block_name_map^
            [apd_data^.loader_seq_descriptor^.local_block_id].section_ordinal := section_ordinal;
      block_number.block_number := apd_data^.loader_seq_descriptor^.local_block_id;
    IFEND;

  PROCEND lop$add_local_block_id;
?? OLDTITLE ??
?? NEWTITLE := '  [XDCL] lop$add_remote_block_id' ??
?? NEWTITLE := '    get_remote_block_name_map_entry' ??
?? EJECT ??

  PROCEDURE lop$add_remote_block_id
    (    procedure_name: pmt$program_name;
     VAR block_number: pmt$block_identifier);

    VAR
      local_block_name_map_copy: ^array [ * ] of pmt$block_name_map_entry,
      abort_status: ^ost$status;


    apd_data^.loader_seq_descriptor^.remote_block_id := apd_data^.loader_seq_descriptor^.remote_block_id + 1;
    block_number.local := FALSE;

    IF apd_data^.loader_seq_descriptor^.block_name_map_exists THEN
      IF apd_data^.loader_seq_descriptor^.remote_block_id <=
            UPPERBOUND (apd_data^.loader_seq_descriptor^.remote_block_name_map^) THEN
        IF (apd_data^.loader_seq_descriptor^.remote_block_name_map^
              [apd_data^.loader_seq_descriptor^.remote_block_id].procedure_name = procedure_name) THEN
          block_number.block_number := apd_data^.loader_seq_descriptor^.remote_block_id;
          RETURN;
        IFEND;
      IFEND;
      lop$report_error (lle$bad_remote_block_name, procedure_name, '', 0);
      PUSH abort_status;
      pmp$cause_condition (loe$abort_load, NIL, abort_status^);
      pmp$exit (abort_status^);
    ELSE
      PUSH local_block_name_map_copy: [0 .. apd_data^.loader_seq_descriptor^.local_block_id];
      local_block_name_map_copy^ := apd_data^.loader_seq_descriptor^.local_block_name_map^;
      RESET apd_data^.loader_seq_descriptor^.seq_ptr TO apd_data^.loader_seq_descriptor^.
            remote_block_name_map;

      NEXT apd_data^.loader_seq_descriptor^.remote_block_name_map:
            [0 .. apd_data^.loader_seq_descriptor^.remote_block_id] IN
            apd_data^.loader_seq_descriptor^.seq_ptr;
      IF apd_data^.loader_seq_descriptor^.remote_block_name_map = NIL THEN
        lop$report_error (lle$eof_encountered_on_apd_file, apd_data^.loader_seq_file_name^, '', 0);
        PUSH abort_status;
        pmp$cause_condition (loe$abort_load, NIL, abort_status^);
        pmp$exit (abort_status^);
      IFEND;

      IF apd_data^.loader_seq_descriptor^.local_block_name_map <> NIL THEN
        NEXT apd_data^.loader_seq_descriptor^.local_block_name_map:
              [0 .. apd_data^.loader_seq_descriptor^.local_block_id] IN
              apd_data^.loader_seq_descriptor^.seq_ptr;
        IF apd_data^.loader_seq_descriptor^.local_block_name_map = NIL THEN
          lop$report_error (lle$eof_encountered_on_apd_file, apd_data^.loader_seq_file_name^, '', 0);
          PUSH abort_status;
          pmp$cause_condition (loe$abort_load, NIL, abort_status^);
          pmp$exit (abort_status^);
        ELSE
          apd_data^.loader_seq_descriptor^.local_block_name_map^ := local_block_name_map_copy^;
        IFEND;
      IFEND;
      apd_data^.loader_seq_descriptor^.remote_block_name_map^
            [apd_data^.loader_seq_descriptor^.remote_block_id].module_name := mpe_remote_module_name;
      apd_data^.loader_seq_descriptor^.remote_block_name_map^
            [apd_data^.loader_seq_descriptor^.remote_block_id].procedure_name := procedure_name;
      block_number.block_number := apd_data^.loader_seq_descriptor^.remote_block_id;
    IFEND;

  PROCEND lop$add_remote_block_id;

MODEND lom$analyze_program_dynamics;
