?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE : APD : Analyze program dynamics' ??
MODULE pmm$analyze_program_dynamics;
?? NEWTITLE := '  Global declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_expression_result
*copyc llt$program_description
*copyc osd$integer_limits
*copyc ost$date
*copyc pme$analyze_program_dynamics
*copyc pmt$loader_seq_descriptor
*copyc pmt$program_parameters
*copyc pmt$task_id
*copyc pmt$task_status
?? POP ??
*copyc amp$fetch_access_information
*copyc amp$get_file_attributes
*copyc amp$get_segment_pointer
*copyc amp$put_next
*copyc amp$return
*copyc amp$set_segment_eoi
*copyc clp$close_display
*copyc clp$convert_file_ref_to_string
*copyc clp$convert_integer_to_rjstring
*copyc clp$convert_integer_to_string
*copyc clp$convert_string_to_file
*copyc clp$get_fs_path_elements
*copyc clp$get_path_description
*copyc clp$new_display_line
*copyc clp$new_display_page
*copyc clp$open_display
*copyc clp$put_display
*copyc clp$reset_for_next_display_page
*copyc clp$scan_command_line
*copyc clp$scan_parameter_list
*copyc clp$trimmed_string_size
*copyc clp$validate_local_file_name
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$generate_log_message
*copyc osp$set_status_abnormal
*copyc pmp$disestablish_cond_handler
*copyc pmp$establish_condition_handler
*copyc pmp$execute_with_apd
*copyc pmp$get_date
*copyc pmp$get_last_path_name
*copyc pmp$get_legible_date_time
*copyc pmp$get_os_version
*copyc pmp$get_apd_task_jobmode_stats
*copyc pmp$log
*copyc pmp$simulate_call_overhead
*copyc pmp$simulate_return_overhead
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  SECTION
    file_attributes: READ;

  VAR
    measures_file_attributes: [STATIC, READ, file_attributes] array [1 .. 3] of fst$file_cycle_attribute :=
          [[fsc$file_contents_and_processor, fsc$unknown_contents, fsc$unknown_processor],
          [fsc$file_organization, amc$sequential], [fsc$record_type, amc$undefined]];

  VAR
    pmv$loader_description: [XREF] pmt$loader_description,
    pmv$loader_seq_descriptor: [XREF] ^pmt$loader_seq_descriptor,
    pmv$interblock_references_hdr: [XREF] ^pmt$interblock_references_hdr,
    pmv$mpe_seq_descriptor: [XREF] pmt$mpe_seq_descriptor,
    pmv$program_description: [XREF] ^pmt$program_description;

?? NEWTITLE := '[XDCL] pmp$restore_program_measures', EJECT ??

  PROCEDURE [XDCL] pmp$restore_program_measures
    (    measures_file: amt$local_file_name;
     VAR status: ost$status);



    VAR
      connectivity_matrix: ^array [0 .. * ] of 0 .. 0ffffff(16),
      contains_data: boolean,

      dummy: [STATIC] array [1 .. 1] of amt$get_item := [[ * , amc$access_mode, * ]],

      existing_file: boolean,
      file: clt$file,
      i: pmt$number_of_object_files,
      local_block_name_map: ^array [0 .. * ] of pmt$block_name_map_entry,
      local_execution_time_totals: ^array [0 .. * ] of pmt$execution_time_totals,
      local_file: boolean,
      measures_file_identifier: amt$file_identifier,
      module_list: ^pmt$module_list,
      number_of_libraries: pmt$number_of_libraries,
      number_of_local_blocks: pmt$block_id,
      number_of_modules: pmt$number_of_modules,
      number_of_object_files: pmt$number_of_object_files,
      number_of_remote_blocks: pmt$block_id,
      object_file_list: ^pmt$object_file_list,
      object_library_list: ^pmt$object_library_list,
      program_attributes: ^pmt$program_attributes,

      read_attachment: [STATIC, READ] array [1 .. 2] of fst$attachment_option :=
            [[fsc$access_and_share_modes, [fsc$specific_access_modes, [fsc$read]],
            [fsc$determine_from_access_modes]], [fsc$create_file, FALSE]],

      remote_block_name_map: ^array [0 .. * ] of pmt$block_name_map_entry,
      remote_execution_time_totals: ^array [0 .. * ] of pmt$execution_time_totals,
      saved_environment_ptr: ^pmt$mpe_environment_descriptor,
      saved_module_list: ^pmt$module_list,
      saved_object_file_list: ^llt$object_file_list,
      saved_object_library_list: ^llt$object_library_list,
      saved_program_attributes: ^llt$program_attributes,
      segment_pointer: amt$segment_pointer;



    amp$get_file_attributes (measures_file, dummy, local_file, existing_file, contains_data, status);
    IF NOT status.normal THEN
      osp$set_status_abnormal ('PM', pme$e_missing_or_empty_file, measures_file, status);
      RETURN;
    IFEND;

    IF NOT contains_data THEN
      osp$set_status_abnormal ('PM', pme$e_missing_or_empty_file, measures_file, status);
      RETURN;
    IFEND;

    fsp$open_file (measures_file, amc$segment, ^read_attachment, NIL, NIL, ^measures_file_attributes, NIL,
          measures_file_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

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

    RESET segment_pointer.sequence_pointer;
    RESET pmv$loader_seq_descriptor^.seq_ptr;
    RESET pmv$mpe_seq_descriptor.seq_ptr;

    NEXT pmv$loader_seq_descriptor IN pmv$loader_seq_descriptor^.seq_ptr;
    IF pmv$loader_seq_descriptor = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
      RETURN;
    IFEND;

    NEXT saved_environment_ptr IN segment_pointer.sequence_pointer;
    IF saved_environment_ptr = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
      RETURN;
    IFEND;

    IF saved_environment_ptr^.verification_header <> mpe_verification_header THEN
      osp$set_status_abnormal ('PM', pme$e_file_not_created_by_mpe, measures_file, status);
      RETURN;
    IFEND;

    number_of_local_blocks := saved_environment_ptr^.number_of_local_blocks;
    number_of_remote_blocks := saved_environment_ptr^.number_of_remote_blocks;

    pmv$loader_seq_descriptor^.local_block_id := number_of_local_blocks;
    pmv$loader_seq_descriptor^.remote_block_id := number_of_remote_blocks;

    NEXT remote_block_name_map: [0 .. number_of_remote_blocks] IN segment_pointer.sequence_pointer;
    IF remote_block_name_map = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
      RETURN;
    IFEND;

    NEXT pmv$loader_seq_descriptor^.remote_block_name_map: [0 .. number_of_remote_blocks] IN
          pmv$loader_seq_descriptor^.seq_ptr;
    IF pmv$loader_seq_descriptor^.remote_block_name_map = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
      RETURN;
    IFEND;

    pmv$loader_seq_descriptor^.remote_block_name_map^ := remote_block_name_map^;

    NEXT local_block_name_map: [0 .. number_of_local_blocks] IN segment_pointer.sequence_pointer;
    IF local_block_name_map = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
      RETURN;
    IFEND;

    NEXT pmv$loader_seq_descriptor^.local_block_name_map: [0 .. number_of_local_blocks] IN
          pmv$loader_seq_descriptor^.seq_ptr;
    IF pmv$loader_seq_descriptor^.local_block_name_map = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
      RETURN;
    IFEND;

    pmv$loader_seq_descriptor^.local_block_name_map^ := local_block_name_map^;

    pmv$loader_seq_descriptor^.block_name_map_exists := TRUE;

    IF pmc$connectivity_matrix IN saved_environment_ptr^.saved_environment THEN
      NEXT connectivity_matrix: [0 .. number_of_local_blocks * number_of_local_blocks] IN
            segment_pointer.sequence_pointer;
      IF connectivity_matrix = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
        RETURN;
      IFEND;

      NEXT pmv$mpe_seq_descriptor.connectivity_matrix: [0 .. number_of_local_blocks *
            number_of_local_blocks] IN pmv$mpe_seq_descriptor.seq_ptr;
      IF pmv$mpe_seq_descriptor.connectivity_matrix = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
        RETURN;
      IFEND;

      pmv$mpe_seq_descriptor.connectivity_matrix^ := connectivity_matrix^;
    ELSE
      pmv$mpe_seq_descriptor.connectivity_matrix := NIL;
    IFEND;

    IF pmc$execution_time_totals IN saved_environment_ptr^.saved_environment THEN
      NEXT remote_execution_time_totals: [0 .. number_of_remote_blocks] IN segment_pointer.sequence_pointer;
      IF remote_execution_time_totals = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
        RETURN;
      IFEND;

      NEXT pmv$mpe_seq_descriptor.remote_execution_time_totals: [0 .. number_of_remote_blocks] IN
            pmv$mpe_seq_descriptor.seq_ptr;
      IF pmv$mpe_seq_descriptor.remote_execution_time_totals = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
        RETURN;
      IFEND;

      pmv$mpe_seq_descriptor.remote_execution_time_totals^ := remote_execution_time_totals^;

      NEXT local_execution_time_totals: [0 .. number_of_local_blocks] IN segment_pointer.sequence_pointer;
      IF local_execution_time_totals = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
        RETURN;
      IFEND;

      NEXT pmv$mpe_seq_descriptor.local_execution_time_totals: [0 .. number_of_local_blocks] IN
            pmv$mpe_seq_descriptor.seq_ptr;
      IF pmv$mpe_seq_descriptor.local_execution_time_totals = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
        RETURN;
      IFEND;

      pmv$mpe_seq_descriptor.local_execution_time_totals^ := local_execution_time_totals^;

      pmv$mpe_seq_descriptor.creation_date := saved_environment_ptr^.creation_date;
      pmv$mpe_seq_descriptor.number_of_runs := saved_environment_ptr^.number_of_runs;
    ELSE
      pmv$mpe_seq_descriptor.local_execution_time_totals := NIL;
      pmv$mpe_seq_descriptor.remote_execution_time_totals := NIL;
    IFEND;

    IF pmv$program_description <> NIL THEN
      FREE pmv$program_description;
    IFEND;

    ALLOCATE pmv$program_description: [[REP saved_environment_ptr^.program_description_size OF cell]];
    IF pmv$program_description = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
      RETURN;
    IFEND;

    RESET pmv$program_description;

    NEXT saved_program_attributes IN segment_pointer.sequence_pointer;
    IF saved_program_attributes = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
      RETURN;
    IFEND;

    NEXT program_attributes IN pmv$program_description;
    IF program_attributes = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
      RETURN;
    IFEND;

    program_attributes^.contents := saved_program_attributes^.contents;
    program_attributes^.maximum_stack_size := saved_program_attributes^.maximum_stack_size;

    IF pmc$starting_proc_specified IN saved_program_attributes^.contents THEN
      program_attributes^.starting_procedure := saved_program_attributes^.starting_procedure;
    IFEND;

    IF pmc$object_file_list_specified IN saved_program_attributes^.contents THEN
      number_of_object_files := saved_program_attributes^.number_of_object_files;
      program_attributes^.number_of_object_files := number_of_object_files;

      NEXT saved_object_file_list: [1 .. number_of_object_files] IN segment_pointer.sequence_pointer;
      IF saved_object_file_list = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
        RETURN;
      IFEND;

      NEXT object_file_list: [1 .. number_of_object_files] IN pmv$program_description;
      IF object_file_list = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
        RETURN;
      IFEND;

      FOR i := 1 TO number_of_object_files DO
        clp$convert_string_to_file (saved_object_file_list^ [i], file, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        object_file_list^ [i] := file.local_file_name;
      FOREND;
    IFEND;

    IF pmc$module_list_specified IN saved_program_attributes^.contents THEN
      number_of_modules := saved_program_attributes^.number_of_modules;
      program_attributes^.number_of_modules := number_of_modules;

      NEXT saved_module_list: [1 .. number_of_modules] IN segment_pointer.sequence_pointer;
      IF saved_module_list = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
        RETURN;
      IFEND;

      NEXT module_list: [1 .. number_of_modules] IN pmv$program_description;
      IF module_list = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
        RETURN;
      IFEND;

      FOR i := 1 TO number_of_modules DO
        module_list^ [i] := saved_module_list^ [i];
      FOREND;
    IFEND;

    IF pmc$library_list_specified IN saved_program_attributes^.contents THEN
      number_of_libraries := saved_program_attributes^.number_of_libraries;
      program_attributes^.number_of_libraries := number_of_libraries;

      NEXT saved_object_library_list: [1 .. number_of_libraries] IN segment_pointer.sequence_pointer;
      IF saved_object_library_list = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
        RETURN;
      IFEND;

      NEXT object_library_list: [1 .. number_of_libraries] IN pmv$program_description;
      IF object_library_list = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
        RETURN;
      IFEND;

      FOR i := 1 TO number_of_libraries DO
        clp$convert_string_to_file (saved_object_library_list^ [i], file, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        object_library_list^ [i] := file.local_file_name;
      FOREND;
    IFEND;

    clp$convert_string_to_file (saved_environment_ptr^.target_text_path_name,
          pmv$loader_description.target_text, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

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

  PROCEND pmp$restore_program_measures;
?? EJECT ??

?? OLDTITLE ??
?? NEWTITLE := '  pmp$save_program_measures' ??

  PROCEDURE [XDCL] pmp$save_program_measures
    (    measures_file: amt$local_file_name;
         amount: pmt$environment_contents;
     VAR status: ost$status);



    VAR
      connectivity_matrix: ^array [0 .. * ] of 0 .. 0ffffff(16),
      cycle_selector: clt$cycle_selector,
      file: clt$file,
      file_reference: clt$file_reference,
      i: pmt$number_of_object_files,
      local_block_name_map: ^array [0 .. * ] of pmt$block_name_map_entry,
      local_execution_time_totals: ^array [0 .. * ] of pmt$execution_time_totals,
      measures_file_identifier: amt$file_identifier,
      module_list: ^pmt$module_list,
      number_of_libraries: pmt$number_of_libraries,
      number_of_local_blocks: pmt$block_id,
      number_of_modules: pmt$number_of_modules,
      number_of_object_files: pmt$number_of_object_files,
      number_of_remote_blocks: pmt$block_id,
      object_file_list: ^pmt$object_file_list,
      object_library_list: ^pmt$object_library_list,
      open_position: clt$open_position,
      path: ^pft$path,
      path_container: clt$path_container,
      program_attributes: ^pmt$program_attributes,
      remote_block_name_map: ^array [0 .. * ] of pmt$block_name_map_entry,
      remote_execution_time_totals: ^array [0 .. * ] of pmt$execution_time_totals,
      saved_environment_ptr: ^pmt$mpe_environment_descriptor,
      saved_module_list: ^pmt$module_list,
      saved_object_file_list: ^llt$object_file_list,
      saved_object_library_list: ^llt$object_library_list,
      saved_program_attributes: ^llt$program_attributes,
      segment_pointer: amt$segment_pointer,
      write_attachment: [STATIC, READ] array [1 .. 2] of fst$attachment_option :=
            [[fsc$access_and_share_modes, [fsc$specific_access_modes, [fsc$read, fsc$append, fsc$modify,
            fsc$shorten]], [fsc$specific_share_modes, []]], [fsc$create_file, TRUE]];

    fsp$open_file (measures_file, amc$segment, ^write_attachment, NIL, ^measures_file_attributes,
          ^measures_file_attributes, NIL, measures_file_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

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

    RESET segment_pointer.sequence_pointer;

    NEXT saved_environment_ptr IN segment_pointer.sequence_pointer;
    IF NOT status.normal THEN
      osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
      RETURN;
    IFEND;

    number_of_local_blocks := pmv$loader_seq_descriptor^.local_block_id;
    number_of_remote_blocks := pmv$loader_seq_descriptor^.remote_block_id;

    saved_environment_ptr^.verification_header := mpe_verification_header;
    saved_environment_ptr^.creation_date := pmv$mpe_seq_descriptor.creation_date;
    saved_environment_ptr^.number_of_runs := pmv$mpe_seq_descriptor.number_of_runs;
    saved_environment_ptr^.number_of_local_blocks := number_of_local_blocks;
    saved_environment_ptr^.number_of_remote_blocks := number_of_remote_blocks;
    saved_environment_ptr^.saved_environment := amount;

    clp$get_path_description (pmv$loader_description.target_text, file_reference, path_container, path,
          cycle_selector, open_position, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    saved_environment_ptr^.target_text_path_name := file_reference.path_name;

    NEXT remote_block_name_map: [0 .. number_of_remote_blocks] IN segment_pointer.sequence_pointer;
    IF remote_block_name_map = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
      RETURN;
    IFEND;

    remote_block_name_map^ := pmv$loader_seq_descriptor^.remote_block_name_map^;

    NEXT local_block_name_map: [0 .. number_of_local_blocks] IN segment_pointer.sequence_pointer;
    IF local_block_name_map = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
      RETURN;
    IFEND;

    local_block_name_map^ := pmv$loader_seq_descriptor^.local_block_name_map^;

    IF pmc$connectivity_matrix IN amount THEN
      NEXT connectivity_matrix: [0 .. number_of_local_blocks * number_of_local_blocks] IN
            segment_pointer.sequence_pointer;
      IF connectivity_matrix = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
        RETURN;
      IFEND;

      connectivity_matrix^ := pmv$mpe_seq_descriptor.connectivity_matrix^;
    IFEND;

    IF pmc$execution_time_totals IN amount THEN
      NEXT remote_execution_time_totals: [0 .. number_of_remote_blocks] IN segment_pointer.sequence_pointer;
      IF remote_execution_time_totals = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
        RETURN;
      IFEND;

      remote_execution_time_totals^ := pmv$mpe_seq_descriptor.remote_execution_time_totals^;

      NEXT local_execution_time_totals: [0 .. number_of_local_blocks] IN segment_pointer.sequence_pointer;
      IF local_execution_time_totals = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
        RETURN;
      IFEND;

      local_execution_time_totals^ := pmv$mpe_seq_descriptor.local_execution_time_totals^;
    IFEND;

    RESET pmv$program_description;

    NEXT program_attributes IN pmv$program_description;
    IF program_attributes = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
      RETURN;
    IFEND;

    NEXT saved_program_attributes IN segment_pointer.sequence_pointer;
    IF saved_program_attributes = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
      RETURN;
    IFEND;

    saved_program_attributes^.contents := program_attributes^.contents;
    saved_program_attributes^.maximum_stack_size := program_attributes^.maximum_stack_size;

    IF pmc$starting_proc_specified IN program_attributes^.contents THEN
      saved_program_attributes^.starting_procedure := program_attributes^.starting_procedure;
    IFEND;

    IF pmc$object_file_list_specified IN program_attributes^.contents THEN
      number_of_object_files := program_attributes^.number_of_object_files;
      saved_program_attributes^.number_of_object_files := number_of_object_files;

      NEXT object_file_list: [1 .. number_of_object_files] IN pmv$program_description;
      IF object_file_list = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
        RETURN;
      IFEND;

      NEXT saved_object_file_list: [1 .. number_of_object_files] IN segment_pointer.sequence_pointer;
      IF saved_object_file_list = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
        RETURN;
      IFEND;

      FOR i := 1 TO number_of_object_files DO
        file.local_file_name := object_file_list^ [i];

        clp$get_path_description (file, file_reference, path_container, path, cycle_selector, open_position,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        saved_object_file_list^ [i] := file_reference.path_name;
      FOREND;
    IFEND;

    IF pmc$module_list_specified IN program_attributes^.contents THEN
      number_of_modules := program_attributes^.number_of_modules;
      saved_program_attributes^.number_of_modules := number_of_modules;

      NEXT module_list: [1 .. number_of_modules] IN pmv$program_description;
      IF module_list = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
        RETURN;
      IFEND;

      NEXT saved_module_list: [1 .. number_of_modules] IN segment_pointer.sequence_pointer;
      IF saved_module_list = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
        RETURN;
      IFEND;

      FOR i := 1 TO number_of_modules DO
        saved_module_list^ [i] := module_list^ [i];
      FOREND;
    IFEND;

    IF pmc$library_list_specified IN program_attributes^.contents THEN
      number_of_libraries := program_attributes^.number_of_libraries;
      saved_program_attributes^.number_of_libraries := number_of_libraries;

      NEXT object_library_list: [1 .. number_of_libraries] IN pmv$program_description;
      IF object_library_list = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
        RETURN;
      IFEND;

      NEXT saved_object_library_list: [1 .. number_of_libraries] IN segment_pointer.sequence_pointer;
      IF saved_object_library_list = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_premature_eof_on_file, measures_file, status);
        RETURN;
      IFEND;

      FOR i := 1 TO number_of_libraries DO
        file.local_file_name := object_library_list^ [i];

        clp$get_path_description (file, file_reference, path_container, path, cycle_selector, open_position,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        saved_object_library_list^ [i] := file_reference.path_name;
      FOREND;
    IFEND;

    saved_environment_ptr^.program_description_size := #SIZE (pmv$program_description^);

    amp$set_segment_eoi (measures_file_identifier, segment_pointer, status);

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

  PROCEND pmp$save_program_measures;
?? OLDTITLE ??
?? NEWTITLE := '  pmp$create_restructure_commands' ??
?? EJECT ??

  PROCEDURE [XDCL] pmp$create_restructure_commands
    (    commands: amt$local_file_name;
         library_file_reference: clt$file_reference;
         gen_module_name: pmt$program_name;
     VAR status: ost$status);

?? NEWTITLE := '    create_intercolumn_bond_matrix' ??
?? EJECT ??

    PROCEDURE create_intercolumn_bond_matrix
      (    connectivity_matrix: ^array [0 .. * ] of 0 .. 0ffffff(16);
       VAR intercolumn_bond_matrix: ^array [1 .. * ] of 0 .. 0ffffffff(16);
       VAR status: ost$status);


      VAR
        i: integer,
        j: integer,
        k: integer,
        number_of_local_blocks: pmt$block_id,
        temp_icbm_element: 0 .. 0ffffffff(16),
        temp_i_index: integer,
        temp_j_index: integer,
        first: integer,
        last: integer,
        column_of_zeros: ^array [1 .. * ] of boolean;


      status.normal := TRUE;

      number_of_local_blocks := pmv$loader_seq_descriptor^.local_block_id;

      PUSH column_of_zeros: [1 .. number_of_local_blocks];
      IF column_of_zeros = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
        RETURN;
      IFEND;

    /loop/
      FOR i := 1 TO number_of_local_blocks DO
        first := (number_of_local_blocks * (i - 1)) + 1;
        last := first + number_of_local_blocks - 1;

        FOR j := first TO last DO
          IF connectivity_matrix^ [j] <> 0 THEN
            column_of_zeros^ [i] := FALSE;
            CYCLE /loop/;
          IFEND;
        FOREND;

        column_of_zeros^ [i] := TRUE;
      FOREND /loop/;


      NEXT intercolumn_bond_matrix: [1 .. (number_of_local_blocks * number_of_local_blocks)] IN
            pmv$loader_seq_descriptor^.seq_ptr;
      IF intercolumn_bond_matrix = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
        RETURN;
      IFEND;
?? EJECT ??

      FOR i := 1 TO number_of_local_blocks DO
        temp_i_index := number_of_local_blocks * (i - 1);

        FOR j := i TO number_of_local_blocks DO
          temp_j_index := number_of_local_blocks * (j - 1);
          temp_icbm_element := 0;

          IF NOT (column_of_zeros^ [i] OR column_of_zeros^ [j]) THEN

            FOR k := 1 TO number_of_local_blocks DO
              temp_icbm_element := temp_icbm_element + (connectivity_matrix^ [temp_i_index + k] *
                    connectivity_matrix^ [temp_j_index + k]);
            FOREND;
          IFEND;

          intercolumn_bond_matrix^ [temp_i_index + j] := temp_icbm_element;
          intercolumn_bond_matrix^ [temp_j_index + i] := temp_icbm_element;
        FOREND;
      FOREND;

    PROCEND create_intercolumn_bond_matrix;
?? EJECT ??

?? OLDTITLE ??
?? NEWTITLE := '    initialize_working_lists' ??

    PROCEDURE initialize_working_lists
      (    number_of_local_blocks: pmt$block_id;
           intercolumn_bond_matrix: ^array [1 .. * ] of 0 .. 0ffffffff(16);
       VAR candidate_list: pmt$candidate_list;
       VAR cluster_list: ^pmt$candidate_list;
       VAR not_called_list: ^pmt$candidate_list;
       VAR status: ost$status);



      VAR
        candidates: ^array [1 .. * ] of pmt$candidate_list,
        current_candidate: ^pmt$candidate_list,
        greatest_value_on_diagonal: integer,
        i: pmt$block_id,
        temporary_candidate: ^pmt$candidate_list;


      status.normal := TRUE;

      candidate_list.link := NIL;
      cluster_list := NIL;
      not_called_list := NIL;

      NEXT candidates: [1 .. number_of_local_blocks] IN pmv$mpe_seq_descriptor.seq_ptr;
      IF candidates = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
        RETURN;
      IFEND;

      greatest_value_on_diagonal := 0;
      temporary_candidate := NIL;

      FOR i := 1 TO number_of_local_blocks DO
        current_candidate := ^candidates^ [i];
        current_candidate^.local_block_id := i;
        current_candidate^.cluster_merit := 0;
        current_candidate^.best_position := NIL;

        IF (pmv$mpe_seq_descriptor.local_execution_time_totals <> NIL) AND
              (pmv$mpe_seq_descriptor.local_execution_time_totals^ [i].number_of_calls = 0) THEN
          current_candidate^.link := not_called_list;
          not_called_list := current_candidate;
        ELSE
          IF intercolumn_bond_matrix^ [number_of_local_blocks * (i - 1) + i] > greatest_value_on_diagonal THEN
            current_candidate := temporary_candidate;
            temporary_candidate := ^candidates^ [i];
            greatest_value_on_diagonal := intercolumn_bond_matrix^ [number_of_local_blocks * (i - 1) + i];
          IFEND;

          IF current_candidate <> NIL THEN
            current_candidate^.link := candidate_list.link;
            candidate_list.link := current_candidate;
          IFEND;
        IFEND;
      FOREND;
?? EJECT ??

      IF temporary_candidate <> NIL THEN
        cluster_list := temporary_candidate;
        cluster_list^.link := NIL;
      IFEND;


    PROCEND initialize_working_lists;
?? OLDTITLE ??
?? NEWTITLE := '    evaluate_candidates' ??
?? EJECT ??

    PROCEDURE evaluate_candidates
      (    number_of_local_blocks: pmt$block_id;
           intercolumn_bond_matrix: ^array [1 .. * ] of 0 .. 0ffffffff(16);
       VAR candidate_list: pmt$candidate_list;
       VAR cluster_list: ^pmt$candidate_list);



      VAR
        current_candidate: ^pmt$candidate_list,
        current_element: ^pmt$candidate_list,
        local_block_id: pmt$block_id,
        test_value: integer;



      current_candidate := candidate_list.link;

      WHILE current_candidate <> NIL DO
        local_block_id := current_candidate^.local_block_id;
        current_candidate^.cluster_merit := intercolumn_bond_matrix^
              [number_of_local_blocks * (cluster_list^.local_block_id - 1) + local_block_id];
        current_candidate^.best_position := cluster_list;
        current_element := cluster_list;

        WHILE current_element <> NIL DO
          IF current_element^.link = NIL THEN
            test_value := intercolumn_bond_matrix^ [number_of_local_blocks *
                  (local_block_id - 1) + current_element^.local_block_id];
          ELSE
            test_value := intercolumn_bond_matrix^ [number_of_local_blocks *
                  (local_block_id - 1) + cluster_list^.local_block_id] +
                  intercolumn_bond_matrix^ [number_of_local_blocks *
                  (cluster_list^.link^.local_block_id - 1) + local_block_id] -
                  intercolumn_bond_matrix^ [number_of_local_blocks *
                  (cluster_list^.link^.local_block_id - 1) + cluster_list^.local_block_id];
          IFEND;

          IF test_value >= current_candidate^.cluster_merit THEN
            current_candidate^.cluster_merit := test_value;
            current_candidate^.best_position := current_element;
          IFEND;

          current_element := current_element^.link;
        WHILEND;

        current_candidate := current_candidate^.link;
      WHILEND;

    PROCEND evaluate_candidates;
?? OLDTITLE ??
?? NEWTITLE := '    select_best_candidate' ??
?? EJECT ??

    PROCEDURE select_best_candidate
      (VAR candidate_list: pmt$candidate_list;
       VAR cluster_list: ^pmt$candidate_list);



      VAR
        best_candidate: ^pmt$candidate_list,
        best_position_in_list: ^pmt$candidate_list,
        current_candidate: ^pmt$candidate_list,
        current_element: ^pmt$candidate_list;



      current_candidate := candidate_list.link;
      best_candidate := ^candidate_list;

      WHILE current_candidate^.link <> NIL DO
        IF current_candidate^.link^.cluster_merit > best_candidate^.link^.cluster_merit THEN
          best_candidate := current_candidate;
        IFEND;
        current_candidate := current_candidate^.link;
      WHILEND;

      best_position_in_list := best_candidate^.link^.best_position;
      current_element := best_position_in_list^.link;
      best_position_in_list^.link := best_candidate^.link;
      best_candidate^.link := best_candidate^.link^.link;
      best_position_in_list^.link^.link := current_element;

    PROCEND select_best_candidate;
?? OLDTITLE ??
?? NEWTITLE := '    generate_optimal_ordering' ??
?? EJECT ??

    PROCEDURE generate_optimal_ordering
      (    intercolumn_bond_matrix: ^array [1 .. * ] of 0 .. 0ffffffff(16);
       VAR cluster_list: ^pmt$candidate_list;
       VAR status: ost$status);



      VAR
        candidate_list: pmt$candidate_list,
        element: ^pmt$candidate_list,
        not_called_list: ^pmt$candidate_list,
        number_of_local_blocks: pmt$block_id;



      status.normal := TRUE;

      number_of_local_blocks := pmv$loader_seq_descriptor^.local_block_id;

      initialize_working_lists (number_of_local_blocks, intercolumn_bond_matrix, candidate_list, cluster_list,
            not_called_list, status);

      IF NOT status.normal THEN
        RETURN;
      IFEND;

      WHILE candidate_list.link <> NIL DO
        evaluate_candidates (number_of_local_blocks, intercolumn_bond_matrix, candidate_list, cluster_list);

        select_best_candidate (candidate_list, cluster_list);
      WHILEND;


      IF cluster_list = NIL THEN
        cluster_list := not_called_list;

      ELSE
        element := cluster_list;

        WHILE element^.link <> NIL DO
          element := element^.link;
        WHILEND;

        element^.link := not_called_list;
      IFEND;


    PROCEND generate_optimal_ordering;
?? OLDTITLE ??
?? NEWTITLE := 'format_restructure_directives', EJECT ??

{ PURPOSE:
{   Build an SCL procedure to restructure the module.

    PROCEDURE format_restructure_directives
      (    command_file: amt$local_file_name;
           object_text_file: clt$file;
           library_file_reference: clt$file_reference;
           gen_module_name: pmt$program_name;
           cluster_list: ^pmt$candidate_list;
           local_block_name_map: ^array [0 .. * ] of pmt$block_name_map_entry;
       VAR status: ost$status);

      VAR
        command_file_attributes: [STATIC, READ] array [1 .. 1] of fst$file_cycle_attribute :=
              [[fsc$file_contents_and_processor, fsc$legible_data, fsc$unknown_processor]],
        command_file_identifier: amt$file_identifier,
        current_module: ^pmt$candidate_list,
        cycle_selector: clt$cycle_selector,
        file: clt$file,
        file_reference: clt$file_reference,
        ignore_byte_address: amt$file_byte_address,
        local_block_id: pmt$block_id,
        open_position: clt$open_position,
        path: ^pft$path,
        path_container: clt$path_container,
        proc_string: string (256),
        section_number: string (7),
        string_index: 0 .. osc$max_string_size,
        write_attachment: [STATIC, READ] array [1 .. 2] of fst$attachment_option :=
              [[fsc$access_and_share_modes, [fsc$specific_access_modes, [fsc$append, fsc$modify,
              fsc$shorten]], [fsc$determine_from_access_modes]], [fsc$create_file, TRUE]];

?? NEWTITLE := 'put_string', EJECT ??

{  PURPOSE:
{    Build a text line and write it to the procedure file when complete.

      PROCEDURE put_string
        (    text: string ( * );
             action: (trim, add, eol));

        proc_string (string_index, STRLENGTH (text)) := text;
        string_index := string_index + STRLENGTH (text);

        IF action = eol THEN
          amp$put_next (command_file_identifier, ^proc_string, string_index - 1, ignore_byte_address, status);
          IF NOT status.normal THEN
            EXIT format_restructure_directives;
          IFEND;
          string_index := 1;
        ELSEIF action = trim THEN
          WHILE proc_string (string_index - 1) = ' ' DO
            string_index := string_index - 1;
          WHILEND;
        IFEND;

      PROCEND put_string;
?? OLDTITLE, EJECT ??
      fsp$open_file (command_file, amc$record, ^write_attachment, NIL, ^command_file_attributes,
            ^command_file_attributes, NIL, command_file_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      string_index := 1;

      put_string ('PROCEDURE ', add);
      file.local_file_name := command_file;
      clp$get_path_description (file, file_reference, path_container, path, cycle_selector, open_position,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      put_string (path^ [UPPERBOUND (path^)], add);
      put_string (' (', eol);

      clp$get_path_description (object_text_file, file_reference, path_container, path, cycle_selector,
            open_position, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      put_string ('  target_text, tt: file = ', add);
      IF file_reference.path_name_size - string_index > osc$max_string_size THEN
        osp$set_status_abnormal ('PM', pme$path_name_too_long_for_mpe, '', status);
        RETURN;
      IFEND;
      put_string (file_reference.path_name (1, file_reference.path_name_size), eol);

      put_string ('  restructured_module, rm: file = ', add);
      IF library_file_reference.path_name_size + string_index > osc$max_string_size THEN
        osp$set_status_abnormal ('PM', pme$path_name_too_long_for_mpe, '', status);
        RETURN;
      IFEND;
      put_string (library_file_reference.path_name (1, library_file_reference.path_name_size), eol);

      put_string ('  restructured_module_name, rmn: program_name = ''', add);
      put_string (gen_module_name, trim);
      put_string ('''', eol);

      put_string ('  status)', eol);

      put_string ('  create_object_library', eol);
      put_string ('    bind_module name=$string(restructured_module_name) file=target_text', add);

      current_module := cluster_list;

      WHILE current_module <> NIL DO
        local_block_id := current_module^.local_block_id;
        put_string (' mode=continue', eol);

        put_string ('    bind_module "', add);
        put_string (local_block_name_map^ [local_block_id].procedure_name, add);
        put_string ('" section_order=((''', add);
        put_string (local_block_name_map^ [local_block_id].module_name, trim);
        clp$convert_integer_to_rjstring (local_block_name_map^ [local_block_id].section_ordinal, 10, FALSE,
              ' ', section_number, status);
        section_number (1) := '''';
        put_string (section_number, add);
        put_string ('))', add);

        current_module := current_module^.link;
      WHILEND;
      put_string (' mode=quit', eol);

      put_string ('    generate_library library=restructured_module', eol);
      put_string ('    quit', eol);
      put_string ('procend', eol);

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

    PROCEND format_restructure_directives;
?? OLDTITLE ??
?? EJECT ??

    VAR
      cluster_list: ^pmt$candidate_list;


    status.normal := TRUE;

    IF pmv$mpe_seq_descriptor.connectivity_matrix = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_no_connectivity_matrix, '', status);
      RETURN;
    IFEND;

    create_intercolumn_bond_matrix (pmv$mpe_seq_descriptor.connectivity_matrix,
          pmv$mpe_seq_descriptor.intercolumn_bond_matrix, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    generate_optimal_ordering (pmv$mpe_seq_descriptor.intercolumn_bond_matrix, cluster_list, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    format_restructure_directives (commands, pmv$loader_description.target_text, library_file_reference,
          gen_module_name, cluster_list, pmv$loader_seq_descriptor^.local_block_name_map, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND pmp$create_restructure_commands;
?? OLDTITLE ??
?? NEWTITLE := '  pmp$create_restructured_module' ??
?? EJECT ??

  PROCEDURE [XDCL] pmp$create_restructured_module
    (    library_file_reference: clt$file_reference;
         module_name: pmt$program_name;
         commands: amt$local_file_name;
     VAR status: ost$status);


    VAR
      command_line: string (256),
      ignore_status: ost$status,
      path: fst$path,
      path_size: fst$path_size,
      evaluated_file_reference: fst$evaluated_file_reference,
      ignore_path_handle: fmt$path_handle,
      local_file_name: amt$local_file_name,
      name_is_path_handle: boolean,
      name_is_valid: boolean;


    status.normal := TRUE;

    IF pmv$program_description = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_no_program_description, '', status);
      RETURN;
    IFEND;

    pmp$create_restructure_commands (commands, library_file_reference, module_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$validate_local_file_name (commands, local_file_name, ignore_path_handle, name_is_path_handle,
          name_is_valid);
    IF name_is_path_handle THEN
      clp$get_fs_path_elements (local_file_name, evaluated_file_reference, status);
      IF NOT status.normal THEN
        osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
        status.normal := TRUE;
        command_line := '$LOCAL.';
        command_line (8, * ) := commands;
      ELSE
        clp$convert_file_ref_to_string (evaluated_file_reference, FALSE, path, path_size, status);
        IF NOT status.normal THEN
          osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
          status.normal := TRUE;
          command_line := '$LOCAL.';
          command_line (8, * ) := commands;
        ELSE
          command_line := path (1, path_size);
        IFEND;
      IFEND;
    ELSE
      command_line := '$LOCAL.';
      command_line (8, * ) := commands;
    IFEND;

    clp$scan_command_line (command_line, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND pmp$create_restructured_module;
?? OLDTITLE ??
?? NEWTITLE := '  pmp$execute_instrumented_task' ??
?? NEWTITLE := '    initialize_sequences' ??
?? EJECT ??

  PROCEDURE [XDCL] pmp$execute_instrumented_task
    (    parameter_list: ^clt$parameter_list;
         connectivity_matrix: boolean;
         cws_interval_size: 0 .. 0ffffffff(16);
     VAR status: ost$status);

?? EJECT ??

    PROCEDURE initialize_sequences
      (    mpe_loader_seq: amt$local_file_name;
       VAR pmv$loader_seq_descriptor: ^pmt$loader_seq_descriptor;
       VAR status: ost$status);


      VAR
        file_attachment: ^fst$attachment_options,
        attribute_validation: ^fst$file_cycle_attributes;

      VAR
        seq_identifier: amt$file_identifier,
        connectivity_matrix_exists: boolean,
        date: ost$date,
        execution_time_totals_exists: boolean,
        i: integer,
        ignore_status: ost$status,
        number_of_local_blocks: pmt$block_id,
        number_of_remote_blocks: pmt$block_id,
        segment_pointer: amt$segment_pointer;


      status.normal := TRUE;

      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$modify, fsc$append, fsc$shorten];
      file_attachment^ [1].share_modes.selector := fsc$determine_from_access_modes;

      PUSH attribute_validation: [1 .. 3];
      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;

      fsp$open_file (mpe_loader_seq, amc$segment, file_attachment, NIL, NIL, attribute_validation, NIL,
            seq_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

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

      RESET segment_pointer.sequence_pointer;

      NEXT pmv$loader_seq_descriptor IN segment_pointer.sequence_pointer;
      IF pmv$loader_seq_descriptor = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_apd_read_error, '', status);
        fsp$close_file (seq_identifier, ignore_status);
        RETURN;
      IFEND;

      pmv$loader_seq_descriptor^.seq_ptr := segment_pointer.sequence_pointer;
      pmv$loader_seq_descriptor^.file_id := seq_identifier;

      IF pmv$loader_seq_descriptor^.mpe_aborted THEN
        osp$set_status_abnormal ('PM', pme$e_fatal_intercept_error, '', status);
        RETURN;
      IFEND;

      connectivity_matrix_exists := FALSE;
      execution_time_totals_exists := FALSE;


      number_of_local_blocks := pmv$loader_seq_descriptor^.local_block_id;
      number_of_remote_blocks := pmv$loader_seq_descriptor^.remote_block_id;

      NEXT pmv$loader_seq_descriptor^.remote_block_name_map: [0 .. number_of_remote_blocks] IN
            pmv$loader_seq_descriptor^.seq_ptr;
      IF pmv$loader_seq_descriptor^.remote_block_name_map = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_apd_read_error, '', status);
        RETURN;
      IFEND;

      NEXT pmv$loader_seq_descriptor^.local_block_name_map: [0 .. number_of_local_blocks] IN
            pmv$loader_seq_descriptor^.seq_ptr;
      IF pmv$loader_seq_descriptor^.local_block_name_map = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_apd_read_error, '', status);
        RETURN;
      IFEND;
      pmv$loader_seq_descriptor^.block_name_map_exists := TRUE;

      RESET pmv$mpe_seq_descriptor.seq_ptr;

      IF pmv$mpe_seq_descriptor.connectivity_matrix <> NIL THEN
        connectivity_matrix_exists := TRUE;
        NEXT pmv$mpe_seq_descriptor.connectivity_matrix: [0 .. (number_of_local_blocks *
              number_of_local_blocks)] IN pmv$mpe_seq_descriptor.seq_ptr;
        IF pmv$mpe_seq_descriptor.connectivity_matrix = NIL THEN
          osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
          RETURN;
        IFEND;
      IFEND;

      IF pmv$mpe_seq_descriptor.local_execution_time_totals <> NIL THEN
        execution_time_totals_exists := TRUE;
        NEXT pmv$mpe_seq_descriptor.remote_execution_time_totals: [0 .. number_of_remote_blocks] IN
              pmv$mpe_seq_descriptor.seq_ptr;
        IF pmv$mpe_seq_descriptor.remote_execution_time_totals = NIL THEN
          osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
          RETURN;
        IFEND;

        NEXT pmv$mpe_seq_descriptor.local_execution_time_totals: [0 .. number_of_local_blocks] IN
              pmv$mpe_seq_descriptor.seq_ptr;
        IF pmv$mpe_seq_descriptor.local_execution_time_totals = NIL THEN
          osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
          RETURN;
        IFEND;
      IFEND;

      fsp$open_file (pmv$loader_seq_descriptor^.first_interblock_segment_name, amc$segment, file_attachment,
            NIL, NIL, attribute_validation, NIL, seq_identifier, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

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

      pmv$loader_seq_descriptor^.last_interblock_segment := segment_pointer.sequence_pointer;

      RESET pmv$loader_seq_descriptor^.last_interblock_segment;
      NEXT pmv$interblock_references_hdr IN pmv$loader_seq_descriptor^.last_interblock_segment;
      IF pmv$interblock_references_hdr = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_apd_read_error, '', status);
        fsp$close_file (seq_identifier, ignore_status);
        RETURN;
      IFEND;

      pmv$interblock_references_hdr^.file_id := seq_identifier;

      IF pmv$interblock_references_hdr^.number_of_interblock_references = 0 THEN
        osp$set_status_abnormal ('PM', pme$e_mpe_loader_abort, '', status);
        RETURN;
      IFEND;

      IF NOT connectivity_matrix THEN
        IF NOT connectivity_matrix_exists THEN
          NEXT pmv$mpe_seq_descriptor.connectivity_matrix: [0 .. (number_of_local_blocks *
                number_of_local_blocks)] IN pmv$mpe_seq_descriptor.seq_ptr;
          IF pmv$mpe_seq_descriptor.connectivity_matrix = NIL THEN
            osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
            RETURN;
          IFEND;

          FOR i := 1 TO (number_of_local_blocks * number_of_local_blocks) DO
            pmv$mpe_seq_descriptor.connectivity_matrix^ [i] := 0;
          FOREND;
        IFEND;
      IFEND;

      IF NOT execution_time_totals_exists THEN
        NEXT pmv$mpe_seq_descriptor.remote_execution_time_totals: [0 .. number_of_remote_blocks] IN
              pmv$mpe_seq_descriptor.seq_ptr;
        IF pmv$mpe_seq_descriptor.remote_execution_time_totals = NIL THEN
          osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
          RETURN;
        IFEND;

        FOR i := 1 TO number_of_remote_blocks DO
          pmv$mpe_seq_descriptor.remote_execution_time_totals^ [i].block_total := 0;
          pmv$mpe_seq_descriptor.remote_execution_time_totals^ [i].number_of_calls := 0;
          pmv$mpe_seq_descriptor.remote_execution_time_totals^ [i].block_paging_total.page_in_count := 0;
          pmv$mpe_seq_descriptor.remote_execution_time_totals^ [i].block_paging_total.
                pages_reclaimed_from_queue := 0;
          pmv$mpe_seq_descriptor.remote_execution_time_totals^ [i].block_paging_total.new_pages_assigned := 0;
          pmv$mpe_seq_descriptor.remote_execution_time_totals^ [i].block_paging_total.page_fault_count := 0;
        FOREND;

        NEXT pmv$mpe_seq_descriptor.local_execution_time_totals: [0 .. number_of_local_blocks] IN
              pmv$mpe_seq_descriptor.seq_ptr;
        IF pmv$mpe_seq_descriptor.local_execution_time_totals = NIL THEN
          osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
          RETURN;
        IFEND;

        FOR i := 1 TO number_of_local_blocks DO
          pmv$mpe_seq_descriptor.local_execution_time_totals^ [i].block_total := 0;
          pmv$mpe_seq_descriptor.local_execution_time_totals^ [i].remote_total := 0;
          pmv$mpe_seq_descriptor.local_execution_time_totals^ [i].number_of_calls := 0;
          pmv$mpe_seq_descriptor.local_execution_time_totals^ [i].block_paging_total.page_in_count := 0;
          pmv$mpe_seq_descriptor.local_execution_time_totals^ [i].block_paging_total.
                pages_reclaimed_from_queue := 0;
          pmv$mpe_seq_descriptor.local_execution_time_totals^ [i].block_paging_total.new_pages_assigned := 0;
          pmv$mpe_seq_descriptor.local_execution_time_totals^ [i].block_paging_total.page_fault_count := 0;
          pmv$mpe_seq_descriptor.local_execution_time_totals^ [i].remote_paging_total.page_in_count := 0;
          pmv$mpe_seq_descriptor.local_execution_time_totals^ [i].remote_paging_total.
                pages_reclaimed_from_queue := 0;
          pmv$mpe_seq_descriptor.local_execution_time_totals^ [i].remote_paging_total.new_pages_assigned := 0;
          pmv$mpe_seq_descriptor.local_execution_time_totals^ [i].remote_paging_total.page_fault_count := 0;
        FOREND;

        pmp$get_date (osc$mdy_date, date, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        pmv$mpe_seq_descriptor.creation_date := date.mdy;
        pmv$mpe_seq_descriptor.number_of_runs := 0;
      IFEND;

      pmv$mpe_seq_descriptor.intercolumn_bond_matrix := NIL;

    PROCEND initialize_sequences;
?? OLDTITLE ??
?? NEWTITLE := '    initialize_cumulative_stats' ??
?? EJECT ??

?? OLDTITLE ??
?? NEWTITLE := '    get_next_free_block_statistic' ??

    PROCEDURE get_next_free_block_statistic
      (VAR stack_ptr: ^pmt$block_statistic;
       VAR status: ost$status);


      CONST
        block_statistic_allocation_unit = 100;


      VAR
        free_list: ^array [1 .. * ] of pmt$block_statistic,
        i: 1 .. block_statistic_allocation_unit;


      status.normal := TRUE;

      IF free_block_statistic_list = NIL THEN
        NEXT free_list: [1 .. block_statistic_allocation_unit] IN pmv$mpe_seq_descriptor.seq_ptr;

        IF free_list = NIL THEN
          osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
          RETURN;
        IFEND;

        FOR i := 1 TO block_statistic_allocation_unit - 1 DO
          free_list^ [i].link := ^free_list^ [i + 1];
        FOREND;
        free_list^ [block_statistic_allocation_unit].link := NIL;

        free_block_statistic_list := ^free_list^ [1];
      IFEND;

      stack_ptr := free_block_statistic_list;
      free_block_statistic_list := free_block_statistic_list^.link;
      stack_ptr^.link := NIL;

    PROCEND get_next_free_block_statistic;
?? OLDTITLE ??
?? NEWTITLE := '    free_block_statistic' ??
?? EJECT ??

    PROCEDURE free_block_statistic
      (VAR stack: ^pmt$block_statistic);



      VAR
        stack_ptr: ^pmt$block_statistic;



      stack_ptr := stack;
      stack := stack^.link;
      stack_ptr^.link := free_block_statistic_list;
      free_block_statistic_list := stack_ptr;


    PROCEND free_block_statistic;
?? OLDTITLE ??
?? NEWTITLE := '    get_next_free_bws_in_list' ??
?? EJECT ??
?? RIGHT := 110 ??

    PROCEDURE get_next_free_bws_in_list
      (VAR block_working_set_pointer: ^pmt$working_set_block_reference;
       VAR status: ost$status);

{    Purpose:
{      To maintain a link list of up to 100 free block_working_set record spaces.  A calling procedure can
{      have the first free record space linked to the end of a given list by providing this procedure with
{      a pointer to the current end of the given list.


      CONST
        blk_working_set_allocation_unit = 100;


      VAR
        i: 1 .. blk_working_set_allocation_unit,
        free_bws_list: ^array [1 .. * ] of pmt$working_set_block_reference;


      status.normal := TRUE;

      IF free_block_working_set_list = NIL THEN
        NEXT free_bws_list: [1 .. blk_working_set_allocation_unit] IN pmv$mpe_seq_descriptor.seq_ptr;
        IF free_bws_list = NIL THEN
          osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
          RETURN;
        IFEND;

        FOR i := 1 TO blk_working_set_allocation_unit - 1 DO
          free_bws_list^ [i].link := ^free_bws_list^ [i + 1];
        FOREND;

        free_bws_list^ [blk_working_set_allocation_unit].link := NIL;
        free_block_working_set_list := ^free_bws_list^ [1];
      IFEND;

      block_working_set_pointer^.link := free_block_working_set_list;
      free_block_working_set_list := free_block_working_set_list^.link;
      block_working_set_pointer := block_working_set_pointer^.link;
      block_working_set_pointer^.link := NIL;

    PROCEND get_next_free_bws_in_list;

?? OLDTITLE ??
?? NEWTITLE := '   free_block_working_set_entry' ??
?? EJECT ??

    PROCEDURE free_block_working_set_entry
      (VAR free_bws_entry: ^pmt$working_set_block_reference);

      VAR
        block_working_set_pointer: ^pmt$working_set_block_reference;

      block_working_set_pointer := free_bws_entry;
      free_bws_entry := free_bws_entry^.link;
      block_working_set_pointer^.link := free_block_working_set_list;
      free_block_working_set_list := block_working_set_pointer;

    PROCEND free_block_working_set_entry;

?? OLDTITLE ??
?? NEWTITLE := '    update_block_working_set' ??
?? EJECT ??

    PROCEDURE update_block_working_set
      (    block_number: pmt$block_id;
           reference_time: pmt$reference_time;
       VAR status: ost$status);



{   Purpose:
{     To update the apd sequence by deleting all sequence entries whose
{     reference_time is less than the reference_time passed to the procedure
{     minus the cws_interval_size.  After these entries have been deleted a
{     pmt$working_set_block_reference entry is added to the end of the list
{     with a nil pointer and the passed values for the reference_time and block
{     number.  The procedure assumes a nil pointer as the signal for the end of the list.

{   Loop to delete sequence entries whose reference_time does not satisfy condition stated above.

      status.normal := TRUE;

      WHILE (block_working_set.link <> NIL) AND (block_working_set.link^.reference_time <
            (reference_time - cws_interval_size)) DO
        free_block_working_set_entry (block_working_set.link);
      WHILEND;

{   Add the new block_working_set entry to the end of the list.

      get_next_free_bws_in_list (last_block_entry_in_set, status);

      last_block_entry_in_set^.reference_time := reference_time;
      last_block_entry_in_set^.block_number := block_number;

    PROCEND update_block_working_set;

?? OLDTITLE ??
?? NEWTITLE := '    detect_critical_reference' ??
?? EJECT ??

    PROCEDURE detect_critical_reference
      (    local_block_id: pmt$block_id;
           reference_time: pmt$reference_time;
       VAR status: ost$status);



      VAR
        found_in_block_working_set: boolean,
        i: pmt$block_id,
        number_of_local_blocks: pmt$block_id,
        working_set_ptr: ^pmt$working_set_block_reference;


      status.normal := TRUE;

      found_in_block_working_set := FALSE;
      number_of_local_blocks := pmv$loader_seq_descriptor^.local_block_id;

      critical_reference_count := critical_reference_count + 1;
      working_set_ptr := block_working_set.link;

    /search_block_working_set/
      WHILE working_set_ptr <> NIL DO
        IF local_block_id = working_set_ptr^.block_number THEN
          found_in_block_working_set := TRUE;
          EXIT /search_block_working_set/;
        IFEND;

        working_set_ptr := working_set_ptr^.link;
      WHILEND /search_block_working_set/;
?? EJECT ??


      IF NOT found_in_block_working_set THEN
        working_set_ptr := block_working_set.link;

      /update_connectivity_strengths/
        WHILE working_set_ptr <> NIL DO

          IF updated_for_critical_reference^ [working_set_ptr^.block_number] <> critical_reference_count THEN
            i := number_of_local_blocks * (working_set_ptr^.block_number - 1) + local_block_id;
            pmv$mpe_seq_descriptor.connectivity_matrix^ [i] :=
                  pmv$mpe_seq_descriptor.connectivity_matrix^ [i] + 1;
            i := number_of_local_blocks * (local_block_id - 1) + working_set_ptr^.block_number;
            pmv$mpe_seq_descriptor.connectivity_matrix^ [i] :=
                  pmv$mpe_seq_descriptor.connectivity_matrix^ [i] + 1;
            updated_for_critical_reference^ [working_set_ptr^.block_number] := critical_reference_count;

          IFEND;

          working_set_ptr := working_set_ptr^.link;
        WHILEND /update_connectivity_strengths/;

        i := number_of_local_blocks * (local_block_id - 1) + local_block_id;
        pmv$mpe_seq_descriptor.connectivity_matrix^ [i] := pmv$mpe_seq_descriptor.connectivity_matrix^ [i] +
              1;
      IFEND;

      update_block_working_set (local_block_id, reference_time, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    PROCEND detect_critical_reference;
?? OLDTITLE ??
?? NEWTITLE := '    push_block_statistic' ??
?? EJECT ??

    PROCEDURE push_block_statistic
      (    reference_time: pmt$reference_time;
           block_id: pmt$block_identifier;
           paging_info: pmt$paging_statistics;
       VAR status: ost$status);



      VAR
        block_statistic_ptr: ^pmt$block_statistic;


      status.normal := TRUE;

      get_next_free_block_statistic (block_statistic_ptr, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      block_statistic_ptr^.link := active_block_stack_ptr;
      active_block_stack_ptr := block_statistic_ptr;

      active_block_stack_ptr^.block_id := block_id;
      active_block_stack_ptr^.call_time := reference_time;
      active_block_stack_ptr^.paging_stats := paging_info;
      active_block_stack_ptr^.subordinate_time := 0;
      active_block_stack_ptr^.subordinate_paging_stats.page_in_count := 0;
      active_block_stack_ptr^.subordinate_paging_stats.pages_reclaimed_from_queue := 0;
      active_block_stack_ptr^.subordinate_paging_stats.new_pages_assigned := 0;
      active_block_stack_ptr^.subordinate_paging_stats.page_fault_count := 0;
      active_block_stack_ptr^.pop_count := 0;

      IF block_id.local THEN
        pmv$mpe_seq_descriptor.local_execution_time_totals^ [block_id.block_number].number_of_calls :=
              pmv$mpe_seq_descriptor.local_execution_time_totals^ [block_id.block_number].number_of_calls + 1;
        IF NOT connectivity_matrix THEN
          detect_critical_reference (block_id.block_number, reference_time, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
      ELSE
        pmv$mpe_seq_descriptor.remote_execution_time_totals^ [block_id.block_number].number_of_calls :=
              pmv$mpe_seq_descriptor.remote_execution_time_totals^ [block_id.block_number].number_of_calls +
              1;
      IFEND;

    PROCEND push_block_statistic;
?? OLDTITLE ??
?? NEWTITLE := '    pop_block_statistic' ??
?? EJECT ??

    PROCEDURE pop_block_statistic
      (    reference_time: pmt$reference_time;
           paging_info: pmt$paging_statistics;
       VAR status: ost$status);



      VAR
        block_time_in_remote: pmt$reference_time,
        current_block_no: pmt$block_id,
        intger: integer,
        new_pages_assigned: 0 .. 0ffffffff(16),
        page_fault_count: 0 .. 0ffffffffff(16),
        pages_in: 0 .. 0ffffffff(16),
        pages_reclaimed: 0 .. 0ffffffff(16),
        pop_count: integer,
        stack_ptr: ^pmt$block_statistic;


      status.normal := TRUE;

      pop_count := active_block_stack_ptr^.pop_count + 1;

      WHILE (pop_count > 0) AND (active_block_stack_ptr <> NIL) DO
        current_block_no := active_block_stack_ptr^.block_id.block_number;
        IF active_block_stack_ptr^.block_id.local THEN
          intger := pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].
                block_total + (reference_time - active_block_stack_ptr^.call_time -
                active_block_stack_ptr^.subordinate_time);

          IF intger <= 0 THEN
            pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].block_total := 0;
          ELSE
            pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].block_total := intger;
          IFEND;

          intger := pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].block_paging_total.
                page_in_count + (paging_info.page_in_count - active_block_stack_ptr^.paging_stats.
                page_in_count - active_block_stack_ptr^.subordinate_paging_stats.page_in_count);

          IF intger <= 0 THEN
            pages_in := 0;
          ELSE
            pages_in := intger;
          IFEND;

          pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].block_paging_total.
                page_in_count := pages_in;

          intger := pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].block_paging_total.
                pages_reclaimed_from_queue + (paging_info.pages_reclaimed_from_queue -
                active_block_stack_ptr^.paging_stats.pages_reclaimed_from_queue -
                active_block_stack_ptr^.subordinate_paging_stats.pages_reclaimed_from_queue);

          IF intger <= 0 THEN
            pages_reclaimed := 0;
          ELSE
            pages_reclaimed := intger;
          IFEND;

          pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].block_paging_total.
                pages_reclaimed_from_queue := pages_reclaimed;

          intger := pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].block_paging_total.
                new_pages_assigned + (paging_info.new_pages_assigned -
                active_block_stack_ptr^.paging_stats.new_pages_assigned -
                active_block_stack_ptr^.subordinate_paging_stats.new_pages_assigned);

          IF intger <= 0 THEN
            new_pages_assigned := 0;
          ELSE
            new_pages_assigned := intger;
          IFEND;

          pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].block_paging_total.
                new_pages_assigned := new_pages_assigned;

          intger := pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].block_paging_total.
                page_fault_count + (paging_info.page_fault_count -
                active_block_stack_ptr^.paging_stats.page_fault_count -
                active_block_stack_ptr^.subordinate_paging_stats.page_fault_count);

          IF intger <= 0 THEN
            page_fault_count := 0;
          ELSE
            page_fault_count := intger;
          IFEND;

          pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].block_paging_total.
                page_fault_count := page_fault_count;

        ELSE
          intger := reference_time - active_block_stack_ptr^.call_time -
                active_block_stack_ptr^.subordinate_time;

          IF intger <= 0 THEN
            block_time_in_remote := 0;
          ELSE
            block_time_in_remote := intger;
          IFEND;

          pmv$mpe_seq_descriptor.remote_execution_time_totals^ [current_block_no].block_total :=
                pmv$mpe_seq_descriptor.remote_execution_time_totals^ [current_block_no].block_total +
                block_time_in_remote;

          intger := paging_info.page_in_count - active_block_stack_ptr^.paging_stats.page_in_count -
                active_block_stack_ptr^.subordinate_paging_stats.page_in_count;

          IF intger <= 0 THEN
            pages_in := 0;
          ELSE
            pages_in := intger;
            pmv$mpe_seq_descriptor.remote_execution_time_totals^ [current_block_no].block_paging_total.
                  page_in_count := pmv$mpe_seq_descriptor.remote_execution_time_totals^ [current_block_no].
                  block_paging_total.page_in_count + pages_in;
          IFEND;

          intger := paging_info.pages_reclaimed_from_queue -
                active_block_stack_ptr^.paging_stats.pages_reclaimed_from_queue -
                active_block_stack_ptr^.subordinate_paging_stats.pages_reclaimed_from_queue;

          IF intger <= 0 THEN
            pages_reclaimed := 0;
          ELSE
            pages_reclaimed := intger;
            pmv$mpe_seq_descriptor.remote_execution_time_totals^ [current_block_no].block_paging_total.
                  pages_reclaimed_from_queue := pmv$mpe_seq_descriptor.
                  remote_execution_time_totals^ [current_block_no].block_paging_total.
                  pages_reclaimed_from_queue + pages_reclaimed;
          IFEND;

          intger := paging_info.new_pages_assigned - active_block_stack_ptr^.paging_stats.new_pages_assigned -
                active_block_stack_ptr^.subordinate_paging_stats.new_pages_assigned;

          IF intger <= 0 THEN
            new_pages_assigned := 0;
          ELSE
            new_pages_assigned := intger;
            pmv$mpe_seq_descriptor.remote_execution_time_totals^ [current_block_no].block_paging_total.
                  new_pages_assigned := pmv$mpe_seq_descriptor.remote_execution_time_totals^
                  [current_block_no].block_paging_total.new_pages_assigned + new_pages_assigned;
          IFEND;

          intger := paging_info.page_fault_count - active_block_stack_ptr^.paging_stats.page_fault_count -
                active_block_stack_ptr^.subordinate_paging_stats.page_fault_count;

          IF intger <= 0 THEN
            page_fault_count := 0;
          ELSE
            page_fault_count := intger;
            pmv$mpe_seq_descriptor.remote_execution_time_totals^ [current_block_no].block_paging_total.
                  page_fault_count := pmv$mpe_seq_descriptor.remote_execution_time_totals^ [current_block_no].
                  block_paging_total.page_fault_count + page_fault_count;
          IFEND;

        IFEND;

        IF active_block_stack_ptr^.link <> NIL THEN
          IF reference_time > active_block_stack_ptr^.call_time THEN
            intger := reference_time - active_block_stack_ptr^.call_time;
          ELSE
            intger := 0;
          IFEND;

          active_block_stack_ptr^.link^.subordinate_time := active_block_stack_ptr^.link^.subordinate_time +
                intger;

          active_block_stack_ptr^.link^.subordinate_paging_stats.page_in_count :=
                active_block_stack_ptr^.link^.subordinate_paging_stats.page_in_count +
                (paging_info.page_in_count - active_block_stack_ptr^.paging_stats.page_in_count);

          active_block_stack_ptr^.link^.subordinate_paging_stats.pages_reclaimed_from_queue :=
                active_block_stack_ptr^.link^.subordinate_paging_stats.pages_reclaimed_from_queue +
                (paging_info.pages_reclaimed_from_queue - active_block_stack_ptr^.paging_stats.
                pages_reclaimed_from_queue);

          active_block_stack_ptr^.link^.subordinate_paging_stats.new_pages_assigned :=
                active_block_stack_ptr^.link^.subordinate_paging_stats.new_pages_assigned +
                (paging_info.new_pages_assigned - active_block_stack_ptr^.paging_stats.new_pages_assigned);

          active_block_stack_ptr^.link^.subordinate_paging_stats.page_fault_count :=
                active_block_stack_ptr^.link^.subordinate_paging_stats.page_fault_count +
                (paging_info.page_fault_count - active_block_stack_ptr^.paging_stats.page_fault_count);

          IF NOT active_block_stack_ptr^.block_id.local THEN
            current_block_no := active_block_stack_ptr^.link^.block_id.block_number;

            IF active_block_stack_ptr^.link^.block_id.local THEN
              intger := pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].
                    remote_total + (intger - active_block_stack_ptr^.subordinate_time);

              IF intger <= 0 THEN
                pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].remote_total := 0;
              ELSE
                pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].remote_total := intger;
              IFEND;

{ Calculate pages_in.

              intger := pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].
                    remote_paging_total.page_in_count + (paging_info.page_in_count -
                    active_block_stack_ptr^.paging_stats.page_in_count -
                    active_block_stack_ptr^.subordinate_paging_stats.page_in_count);

              IF intger <= 0 THEN
                pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].remote_paging_total.
                      page_in_count := 0;
              ELSE
                pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].remote_paging_total.
                      page_in_count := intger;
              IFEND;

{ Calculate pages_reclaimed.

              intger := pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].
                    remote_paging_total.pages_reclaimed_from_queue +
                    (paging_info.pages_reclaimed_from_queue - active_block_stack_ptr^.paging_stats.
                    pages_reclaimed_from_queue - active_block_stack_ptr^.subordinate_paging_stats.
                    pages_reclaimed_from_queue);

              IF intger <= 0 THEN
                pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].remote_paging_total.
                      pages_reclaimed_from_queue := 0;
              ELSE
                pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].remote_paging_total.
                      pages_reclaimed_from_queue := intger;
              IFEND;

{ Calculate new_pages_assigned.

              intger := pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].
                    remote_paging_total.new_pages_assigned + (paging_info.new_pages_assigned -
                    active_block_stack_ptr^.paging_stats.new_pages_assigned -
                    active_block_stack_ptr^.subordinate_paging_stats.new_pages_assigned);

              IF intger <= 0 THEN
                pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].remote_paging_total.
                      new_pages_assigned := 0;
              ELSE
                pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].remote_paging_total.
                      new_pages_assigned := intger;
              IFEND;

{ Calculate page_fault_count.

              intger := pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].
                    remote_paging_total.page_fault_count + (paging_info.page_fault_count -
                    active_block_stack_ptr^.paging_stats.page_fault_count -
                    active_block_stack_ptr^.subordinate_paging_stats.page_fault_count);

              IF intger <= 0 THEN
                pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].remote_paging_total.
                      page_fault_count := 0;
              ELSE
                pmv$mpe_seq_descriptor.local_execution_time_totals^ [current_block_no].remote_paging_total.
                      page_fault_count := intger;
              IFEND;

            ELSE

              pmv$mpe_seq_descriptor.remote_execution_time_totals^ [current_block_no].block_total :=
                    pmv$mpe_seq_descriptor.remote_execution_time_totals^ [current_block_no].block_total +
                    block_time_in_remote;
              pmv$mpe_seq_descriptor.remote_execution_time_totals^ [current_block_no].block_paging_total.
                    page_in_count := pmv$mpe_seq_descriptor.remote_execution_time_totals^ [current_block_no].
                    block_paging_total.page_in_count + pages_in;
              pmv$mpe_seq_descriptor.remote_execution_time_totals^ [current_block_no].block_paging_total.
                    pages_reclaimed_from_queue := pmv$mpe_seq_descriptor.
                    remote_execution_time_totals^ [current_block_no].block_paging_total.
                    pages_reclaimed_from_queue + pages_reclaimed;
              pmv$mpe_seq_descriptor.remote_execution_time_totals^ [current_block_no].block_paging_total.
                    new_pages_assigned := pmv$mpe_seq_descriptor.remote_execution_time_totals^ [
                    current_block_no].block_paging_total.new_pages_assigned + new_pages_assigned;
              pmv$mpe_seq_descriptor.remote_execution_time_totals^ [current_block_no].block_paging_total.
                    page_fault_count := pmv$mpe_seq_descriptor.remote_execution_time_totals^
                    [current_block_no].block_paging_total.page_fault_count + page_fault_count;

              active_block_stack_ptr^.link^.subordinate_time :=
                    active_block_stack_ptr^.link^.subordinate_time + active_block_stack_ptr^.subordinate_time;
              active_block_stack_ptr^.link^.subordinate_paging_stats.page_in_count :=
                    active_block_stack_ptr^.link^.subordinate_paging_stats.page_in_count +
                    active_block_stack_ptr^.subordinate_paging_stats.page_in_count;
              active_block_stack_ptr^.link^.subordinate_paging_stats.pages_reclaimed_from_queue :=
                    active_block_stack_ptr^.link^.subordinate_paging_stats.pages_reclaimed_from_queue +
                    active_block_stack_ptr^.subordinate_paging_stats.pages_reclaimed_from_queue;
              active_block_stack_ptr^.link^.subordinate_paging_stats.new_pages_assigned :=
                    active_block_stack_ptr^.link^.subordinate_paging_stats.new_pages_assigned +
                    active_block_stack_ptr^.subordinate_paging_stats.new_pages_assigned;
              active_block_stack_ptr^.link^.subordinate_paging_stats.page_fault_count :=
                    active_block_stack_ptr^.link^.subordinate_paging_stats.page_fault_count +
                    active_block_stack_ptr^.subordinate_paging_stats.page_fault_count;

              pmv$mpe_seq_descriptor.remote_execution_time_totals^
                    [active_block_stack_ptr^.block_id.block_number].number_of_calls :=
                    pmv$mpe_seq_descriptor.remote_execution_time_totals^
                    [active_block_stack_ptr^.block_id.block_number].number_of_calls - 1;
              pmv$mpe_seq_descriptor.remote_execution_time_totals^
                    [active_block_stack_ptr^.block_id.block_number].block_total :=
                    pmv$mpe_seq_descriptor.remote_execution_time_totals^
                    [active_block_stack_ptr^.block_id.block_number].block_total - block_time_in_remote;
              pmv$mpe_seq_descriptor.remote_execution_time_totals^
                    [active_block_stack_ptr^.block_id.block_number].block_paging_total.page_in_count :=
                    pmv$mpe_seq_descriptor.remote_execution_time_totals^
                    [active_block_stack_ptr^.block_id.block_number].block_paging_total.page_in_count -
                    pages_in;
              pmv$mpe_seq_descriptor.remote_execution_time_totals^
                    [active_block_stack_ptr^.block_id.block_number].block_paging_total.
                    pages_reclaimed_from_queue := pmv$mpe_seq_descriptor.
                    remote_execution_time_totals^ [active_block_stack_ptr^.block_id.block_number].
                    block_paging_total.pages_reclaimed_from_queue - pages_reclaimed;
              pmv$mpe_seq_descriptor.remote_execution_time_totals^
                    [active_block_stack_ptr^.block_id.block_number].block_paging_total.new_pages_assigned :=
                    pmv$mpe_seq_descriptor.remote_execution_time_totals^
                    [active_block_stack_ptr^.block_id.block_number].block_paging_total.new_pages_assigned -
                    new_pages_assigned;
              pmv$mpe_seq_descriptor.remote_execution_time_totals^
                    [active_block_stack_ptr^.block_id.block_number].block_paging_total.page_fault_count :=
                    pmv$mpe_seq_descriptor.remote_execution_time_totals^
                    [active_block_stack_ptr^.block_id.block_number].block_paging_total.page_fault_count -
                    page_fault_count;
            IFEND;
          IFEND;
        IFEND;

        pop_count := pop_count - 1;

        free_block_statistic (active_block_stack_ptr);
      WHILEND;


      IF NOT connectivity_matrix THEN
        IF active_block_stack_ptr <> NIL THEN
          IF active_block_stack_ptr^.block_id.local THEN
            detect_critical_reference (active_block_stack_ptr^.block_id.block_number, reference_time, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;
        IFEND;
      IFEND;

    PROCEND pop_block_statistic;
?? OLDTITLE ??
?? NEWTITLE := '    determine_reference_type' ??
?? EJECT ??

    PROCEDURE determine_reference_type
      (VAR status: ost$status);


      VAR
        attribute_validation: ^fst$file_cycle_attributes,
        current_interblock_reference: pmt$interblock_reference,
        file_attachment: ^fst$attachment_options,
        file_id: amt$file_identifier,
        i: integer,
        ignore_status: ost$status,
        interblock_reference_string: ^array [1 .. * ] of pmt$interblock_reference,
        next_file_name: amt$local_file_name,
        number_of_segments: ost$positive_integers,
        previous_file_name: amt$local_file_name,
        segment: ost$positive_integers,
        segment_pointer: amt$segment_pointer;

      status.normal := TRUE;

      active_block_stack_ptr := NIL;
      block_working_set.link := NIL;
      free_block_statistic_list := NIL;
      free_block_working_set_list := NIL;
      last_block_entry_in_set := ^block_working_set;
      critical_reference_count := 0;

      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$modify];
      file_attachment^ [1].share_modes.selector := fsc$determine_from_access_modes;

      PUSH attribute_validation: [1 .. 3];
      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;

      PUSH updated_for_critical_reference: [0 .. pmv$loader_seq_descriptor^.local_block_id];
      IF updated_for_critical_reference = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
        RETURN;
      IFEND;

      FOR i := 1 TO pmv$loader_seq_descriptor^.local_block_id DO
        updated_for_critical_reference^ [i] := 0;
      FOREND;

      number_of_segments := pmv$loader_seq_descriptor^.number_of_interblock_segments;
      pmv$loader_seq_descriptor^.number_of_interblock_segments := 1;
      FOR segment := 1 TO number_of_segments DO
        NEXT interblock_reference_string: [1 .. pmv$interblock_references_hdr^.
              number_of_interblock_references] IN pmv$loader_seq_descriptor^.last_interblock_segment;
        IF interblock_reference_string = NIL THEN
          osp$set_status_abnormal ('PM', pme$e_internal_apd_read_error, '', status);
          RETURN;
        IFEND;
        FOR i := 1 TO pmv$interblock_references_hdr^.number_of_interblock_references DO
          current_interblock_reference := interblock_reference_string^ [i];

          CASE current_interblock_reference.reference_type OF
          = pmc$call =
            push_block_statistic (current_interblock_reference.reference_time,
                  current_interblock_reference.block_id, current_interblock_reference.page_fault_stats,
                  status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;

          = pmc$return =
            pop_block_statistic (current_interblock_reference.reference_time,
                  current_interblock_reference.page_fault_stats, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;

          = pmc$final_return =
            IF active_block_stack_ptr <> NIL THEN
              pop_block_statistic (current_interblock_reference.reference_time,
                    current_interblock_reference.page_fault_stats, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
            IFEND;

          = pmc$pop =
            active_block_stack_ptr^.pop_count := active_block_stack_ptr^.pop_count + 1;

          ELSE
            osp$set_status_abnormal ('PM', pme$e_internal_apd_read_error, '', status);
            RETURN;

          CASEND;
        FOREND;

{ Open the next interblock reference file.  Return all files except the first
{ one as they are processed.

        next_file_name := pmv$interblock_references_hdr^.next_segment_file_name;
        IF next_file_name <> osc$null_name THEN
          IF segment = 1 THEN
            pmv$interblock_references_hdr^.next_segment_file_name := osc$null_name;
            fsp$close_file (pmv$interblock_references_hdr^.file_id, ignore_status);
            pmv$interblock_references_hdr := NIL;
          ELSE
            fsp$close_file (pmv$interblock_references_hdr^.file_id, ignore_status);
            pmv$interblock_references_hdr := NIL;
            amp$return (previous_file_name, ignore_status);
          IFEND;
          previous_file_name := next_file_name;

          fsp$open_file (next_file_name, amc$segment, file_attachment, NIL, NIL, attribute_validation,
                NIL, file_id, status);
          IF NOT status.normal THEN
            amp$return (next_file_name, ignore_status);
            RETURN;
          IFEND;

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


          pmv$loader_seq_descriptor^.last_interblock_segment := segment_pointer.sequence_pointer;
          RESET pmv$loader_seq_descriptor^.last_interblock_segment;
          NEXT pmv$interblock_references_hdr IN pmv$loader_seq_descriptor^.last_interblock_segment;
          IF pmv$interblock_references_hdr = NIL THEN
            osp$set_status_abnormal ('PM', pme$e_internal_apd_read_error, '', status);
            fsp$close_file (file_id, ignore_status);
            amp$return (next_file_name, ignore_status);
            RETURN;
          IFEND;

          pmv$interblock_references_hdr^.file_id := file_id;
        ELSE
          IF segment <> 1 THEN
            fsp$close_file (pmv$interblock_references_hdr^.file_id, ignore_status);
            pmv$interblock_references_hdr := NIL;
            amp$return (previous_file_name, ignore_status);

            fsp$open_file (pmv$loader_seq_descriptor^.first_interblock_segment_name, amc$segment,
                  file_attachment, NIL, NIL, attribute_validation, NIL, file_id, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;

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

            pmv$loader_seq_descriptor^.last_interblock_segment := segment_pointer.sequence_pointer;
            RESET pmv$loader_seq_descriptor^.last_interblock_segment;
            NEXT pmv$interblock_references_hdr IN pmv$loader_seq_descriptor^.last_interblock_segment;
            IF pmv$interblock_references_hdr = NIL THEN
              osp$set_status_abnormal ('PM', pme$e_internal_apd_read_error, '', status);
              fsp$close_file (file_id, ignore_status);
              RETURN;
            IFEND;

            pmv$interblock_references_hdr^.file_id := file_id;
          IFEND;
        IFEND;
      FOREND;

    PROCEND determine_reference_type;
?? OLDTITLE ??
?? NEWTITLE := '    initialize_intercept_variables', EJECT ??

{ PURPOSE:
{   The purpose of this request is to initialize the variables in the
{   loader_seq_descriptor file that are used to manage the overhead time
{   generated while intercepting the program calls and returns of an
{   instrumented task.
{ DESIGN:
{   This procedure calculates the average values for some of the overhead
{   time generated in the APD intercept procedures which cannot be timed
{   during the intercept process.
{ NOTES:
{   This procedure is executed prior to executing an instrumented task.

    PROCEDURE initialize_intercept_variables
      (VAR loader_seq_descriptor_p: ^pmt$loader_seq_descriptor);

      VAR
        assemble_call_overhead: pmt$reference_time,
        assemble_return_overhead: pmt$reference_time,
        count: 1 .. 40,
        cp_time: array [1 .. 11] of pmt$apd_task_jobmode_statistics,
        i: 1 .. 40,
        intercept_overhead: pmt$reference_time,
        temp_time: pmt$reference_time;

      loader_seq_descriptor_p^.accumulated_intercept_time := 0;
      loader_seq_descriptor_p^.number_of_intercepted_calls := 0;
      loader_seq_descriptor_p^.number_of_intercepted_returns := 0;
      loader_seq_descriptor_p^.accum_intercept_call_time := 0;
      loader_seq_descriptor_p^.accum_intercept_return_time := 0;
      loader_seq_descriptor_p^.average_intercept_call_time := 0;
      loader_seq_descriptor_p^.average_intercept_return_time := 0;
      loader_seq_descriptor_p^.average_stats_request_time := 0;
      loader_seq_descriptor_p^.timed_call_overhead := 0;
      loader_seq_descriptor_p^.timed_return_overhead := 0;
      loader_seq_descriptor_p^.untimed_call_overhead := 0;
      loader_seq_descriptor_p^.untimed_return_overhead := 0;
      loader_seq_descriptor_p^.average_null_procedure_time := 0;

      count := 40;

{ Calculate the average time to execute a call to pmp$get_apd_task_jobmode_stats.

      temp_time := 0;

      FOR i := 1 TO 5 DO
        pmp$get_apd_task_jobmode_stats (cp_time [1]);
        pmp$get_apd_task_jobmode_stats (cp_time [2]);
        pmp$get_apd_task_jobmode_stats (cp_time [3]);
        pmp$get_apd_task_jobmode_stats (cp_time [4]);
        pmp$get_apd_task_jobmode_stats (cp_time [5]);
        pmp$get_apd_task_jobmode_stats (cp_time [6]);
        pmp$get_apd_task_jobmode_stats (cp_time [7]);
        pmp$get_apd_task_jobmode_stats (cp_time [8]);
        pmp$get_apd_task_jobmode_stats (cp_time [9]);
        pmp$get_apd_task_jobmode_stats (cp_time [10]);
        pmp$get_apd_task_jobmode_stats (cp_time [11]);
        temp_time := temp_time + ((cp_time [11].jobmode_cptime - cp_time [1].jobmode_cptime) DIV 10);
      FOREND;
      loader_seq_descriptor_p^.average_stats_request_time := temp_time DIV 5;

{ Calculate the average time to call a null procedure.

      pmp$get_apd_task_jobmode_stats (cp_time [1]);
      FOR i := 1 TO count DO
        execute_null_procedure;
      FOREND;
      pmp$get_apd_task_jobmode_stats (cp_time [2]);
      loader_seq_descriptor_p^.average_null_procedure_time := (cp_time [2].jobmode_cptime -
            cp_time [1].jobmode_cptime - loader_seq_descriptor_p^.average_stats_request_time)
            DIV count;

{ Calculate the average ASSEMBLE overhead time to intercept a call or return
{ that cannot be calculated in CYBIL.

      pmp$get_apd_task_jobmode_stats (cp_time [1]);
      FOR i := 1 TO count DO
        pmp$simulate_call_overhead;
      FOREND;
      pmp$get_apd_task_jobmode_stats (cp_time [2]);
      assemble_call_overhead := ((cp_time [2].jobmode_cptime - cp_time [1].jobmode_cptime -
            loader_seq_descriptor_p^.average_stats_request_time) DIV count) -
            loader_seq_descriptor_p^.average_null_procedure_time;

      pmp$get_apd_task_jobmode_stats (cp_time [1]);
      FOR i := 1 TO count DO
        pmp$simulate_return_overhead;
      FOREND;
      pmp$get_apd_task_jobmode_stats (cp_time [2]);
      assemble_return_overhead := ((cp_time [2].jobmode_cptime - cp_time [1].jobmode_cptime -
            loader_seq_descriptor_p^.average_stats_request_time) DIV count) -
            loader_seq_descriptor_p^.average_null_procedure_time;

{ Calculate the average overhead time to intercept a call or return that is
{ being timed by the intercept procedures.

      pmp$get_apd_task_jobmode_stats (cp_time [1]);
      FOR i := 1 TO count DO
        simulate_timed_request (loader_seq_descriptor_p);
      FOREND;
      pmp$get_apd_task_jobmode_stats (cp_time [2]);
      intercept_overhead := ((cp_time [2].jobmode_cptime - cp_time [1].jobmode_cptime -
            loader_seq_descriptor_p^.average_stats_request_time) DIV count) -
            loader_seq_descriptor_p^.average_null_procedure_time;

      loader_seq_descriptor_p^.timed_call_overhead := intercept_overhead + assemble_call_overhead;
      loader_seq_descriptor_p^.timed_return_overhead := intercept_overhead + assemble_return_overhead;

{ Calculate the average overhead time to intercept a call or return that is
{ not being timed by the intercept procedures.

      pmp$get_apd_task_jobmode_stats (cp_time [1]);
      FOR i := 1 TO count DO
        simulate_untimed_request (loader_seq_descriptor_p);
      FOREND;
      pmp$get_apd_task_jobmode_stats (cp_time [2]);
      intercept_overhead := ((cp_time [2].jobmode_cptime - cp_time [1].jobmode_cptime -
            loader_seq_descriptor_p^.average_stats_request_time) DIV count) -
            loader_seq_descriptor_p^.average_null_procedure_time;

      loader_seq_descriptor_p^.untimed_call_overhead := intercept_overhead + assemble_call_overhead;
      loader_seq_descriptor_p^.untimed_return_overhead := intercept_overhead + assemble_return_overhead;

      loader_seq_descriptor_p^.accumulated_intercept_time := 0;
      loader_seq_descriptor_p^.accum_intercept_call_time := 0;

    PROCEND initialize_intercept_variables;
?? OLDTITLE ??
?? NEWTITLE := '    simulate_timed_request', EJECT ??

{ PURPOSE:
{   The purpose of this request is to simulate overhead code in the APD
{   intercept procedures that is executed when the intercept procedures are
{   timing a call or return explicitly.
{ NOTES:
{   Modifications to the intercept procedures for calls and returns may
{   require similar modifications in this procedure.

    PROCEDURE simulate_timed_request
      (VAR loader_seq_descriptor_p: ^pmt$loader_seq_descriptor);

      VAR
        initial_cptime: [STATIC] pmt$reference_time := 171,
        statistics: pmt$apd_task_jobmode_statistics;

      pmp$get_apd_task_jobmode_stats (statistics);
      loader_seq_descriptor_p^.accumulated_intercept_time := loader_seq_descriptor_p^.
            accumulated_intercept_time + loader_seq_descriptor_p^.timed_call_overhead +
            (statistics.jobmode_cptime - initial_cptime);
      loader_seq_descriptor_p^.accum_intercept_call_time := loader_seq_descriptor_p^.
            accum_intercept_call_time + loader_seq_descriptor_p^.untimed_call_overhead +
            (statistics.jobmode_cptime - initial_cptime);

    PROCEND simulate_timed_request;
?? OLDTITLE ??
?? NEWTITLE := '    simulate_untimed_request', EJECT ??

{ PURPOSE:
{   The purpose of this request is to simulate overhead code in the APD
{   intercept procedures that is executed when the intercept procedures are
{   using an average value to time a call or return.
{ NOTES:
{   Modifications to the intercept procedures for calls and returns may
{   require similar modifications in this procedure.

    PROCEDURE simulate_untimed_request
      (VAR loader_seq_descriptor_p: ^pmt$loader_seq_descriptor);

      VAR
        statistics: pmt$apd_task_jobmode_statistics;

      pmp$get_apd_task_jobmode_stats (statistics);
      loader_seq_descriptor_p^.accumulated_intercept_time := loader_seq_descriptor_p^.
            accumulated_intercept_time + loader_seq_descriptor_p^.average_intercept_call_time;

    PROCEND simulate_untimed_request;
?? OLDTITLE ??
?? NEWTITLE := '    execute_null_procedure', EJECT ??

{ PURPOSE:
{   The purpose of this request is to execute a procedure consisting only of
{   PROCEDURE and PROCEND statements.

    PROCEDURE execute_null_procedure;
    PROCEND execute_null_procedure;
?? OLDTITLE ??
?? EJECT ??

    VAR
      date: ost$date,
      active_block_stack_ptr: ^pmt$block_statistic,
      block_working_set: pmt$working_set_block_reference,
      critical_reference_count: 0 .. 0ffffff(16),
      fetch_attr: array [1 .. 1] of amt$access_info,
      free_block_statistic_list: ^pmt$block_statistic,
      free_block_working_set_list: ^pmt$working_set_block_reference,
      i: 1 .. 10,
      ignore_status: ost$status,
      last_block_entry_in_set: ^pmt$working_set_block_reference,
      secondary_status: ost$status,
      task_id: pmt$task_id,
      task_status: pmt$task_status,
      updated_for_critical_reference: ^array [0 .. * ] of 0 .. 0ffffff(16);



    IF pmv$program_description = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_no_program_description, '', status);
      RETURN;
    IFEND;

    IF pmv$interblock_references_hdr <> NIL THEN
      fsp$close_file (pmv$interblock_references_hdr^.file_id, status);
      pmv$interblock_references_hdr := NIL;
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    IF pmv$loader_seq_descriptor <> NIL THEN
      initialize_intercept_variables (pmv$loader_seq_descriptor);
      fsp$close_file (pmv$loader_seq_descriptor^.file_id, status);
      pmv$loader_seq_descriptor := NIL;
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    pmp$execute_with_apd (pmv$program_description^, pmv$loader_description, parameter_list^, osc$wait,
          task_id, task_status, status);

    initialize_sequences (pmv$loader_description.mpe_loader_seq, pmv$loader_seq_descriptor, secondary_status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fetch_attr [1].key := amc$eoi_byte_address;
    amp$fetch_access_information (pmv$interblock_references_hdr^.file_id, fetch_attr, ignore_status);
    IF fetch_attr [1].eoi_byte_address > 1999999000 THEN
      pmp$log(' WARNING - statistics collected by EXEIT were truncated to 2 GB of data.', ignore_status);
    IFEND;

    IF NOT task_status.status.normal THEN
      status := task_status.status;
      RETURN;
    IFEND;

    IF NOT secondary_status.normal THEN
      status := secondary_status;
      RETURN;
    IFEND;

    pmv$mpe_seq_descriptor.number_of_runs := pmv$mpe_seq_descriptor.number_of_runs + 1;

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


  PROCEND pmp$execute_instrumented_task;
?? EJECT ??
?? OLDTITLE ??
?? NEWTITLE := '  pmp$display_program_profile' ??

  PROCEDURE [XDCL] pmp$display_program_profile
    (    profile_order: pmt$profile_order;
         procedures: pmt$procedures;
         number: 0 .. 0ffffffff(16);
         output: clt$file;
     VAR status: ost$status);

{   purpose:
{     to produce and print a program profile report containing execution-
{     time and other pertinent program execution statistics on local blocks of a program as well
{     as the remote blocks that the program calls.

?? NEWTITLE := '    new_page_proc', EJECT ??

    PROCEDURE new_page_proc
      (VAR display_control: clt$display_control;
           new_page_number: integer;
       VAR status: ost$status);

      VAR
        l: integer;

      clp$reset_for_next_display_page (display_control, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      STRINGREP (page_header (117, * ), l, display_control.page_number);
      clp$put_display (display_control, page_header, clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$new_display_line (display_control, 2, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF NOT first_entry THEN
        FOR i := 1 TO 3 DO
          clp$put_display (display_control, table_header [i], clc$trim, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        FOREND;
        FOR i := 1 TO 3 DO
          clp$put_display (display_control, table_header2 [i], clc$trim, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        FOREND;
        clp$put_display (display_control, underline, clc$trim, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        clp$new_display_line (display_control, 1, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      ELSE
        first_entry := FALSE;
      IFEND;

    PROCEND new_page_proc;
?? OLDTITLE ??
?? NEWTITLE := '    sort_by_module_procedure', EJECT ??

    PROCEDURE sort_by_module_procedure
      (    block_name_array: ^array [0 .. * ] of pmt$block_name_map_entry;
       VAR index_array: ^array [0 .. * ] of pmt$block_id);



      VAR
        i: pmt$block_id,
        number_of_changes: -1 .. 7fffffff(16),
        temporary_index_array_entry: pmt$block_id,
        number_of_sort_passes: pmt$block_id;




      number_of_changes := UPPERBOUND (block_name_array^) - 1;

      REPEAT
        number_of_sort_passes := number_of_changes;
        number_of_changes := 0;

        FOR i := 1 TO number_of_sort_passes DO
          IF block_name_array^ [index_array^ [i]].module_name >
                block_name_array^ [index_array^ [i + 1]].module_name THEN
            number_of_changes := i - 1;
            temporary_index_array_entry := index_array^ [i];
            index_array^ [i] := index_array^ [i + 1];
            index_array^ [i + 1] := temporary_index_array_entry;
          IFEND;
        FOREND;
      UNTIL number_of_changes <= 0;

    PROCEND sort_by_module_procedure;
?? OLDTITLE ??
?? NEWTITLE := '    sort_by_procedure', EJECT ??

    PROCEDURE sort_by_procedure
      (    block_name_array: ^array [0 .. * ] of pmt$block_name_map_entry;
       VAR index_array: ^array [0 .. * ] of pmt$block_id);



      VAR
        i: pmt$block_id,
        number_of_changes: -1 .. 7fffffff(16),
        temporary_index_array_entry: pmt$block_id,
        number_of_sort_passes: pmt$block_id;




      number_of_changes := UPPERBOUND (block_name_array^) - 1;

      REPEAT
        number_of_sort_passes := number_of_changes;
        number_of_changes := 0;

        FOR i := 1 TO number_of_sort_passes DO
          IF block_name_array^ [index_array^ [i]].procedure_name >
                block_name_array^ [index_array^ [i + 1]].procedure_name THEN
            number_of_changes := i - 1;
            temporary_index_array_entry := index_array^ [i];
            index_array^ [i] := index_array^ [i + 1];
            index_array^ [i + 1] := temporary_index_array_entry;
          IFEND;
        FOREND;
      UNTIL number_of_changes <= 0;

    PROCEND sort_by_procedure;
?? OLDTITLE ??
?? NEWTITLE := '    sort_by_time', EJECT ??

    PROCEDURE sort_by_time
      (    execution_time_totals_array: ^array [0 .. * ] of pmt$execution_time_totals;
       VAR index_array: ^array [0 .. * ] of pmt$block_id);



      VAR
        i: pmt$block_id,
        number_of_changes: -1 .. 7ffffffff(16),
        temporary_index_array_entry: pmt$block_id,
        number_of_sort_passes: pmt$block_id;



      number_of_changes := UPPERBOUND (execution_time_totals_array^) - 1;

      REPEAT
        number_of_sort_passes := number_of_changes;
        number_of_changes := 0;


        FOR i := 1 TO number_of_sort_passes DO
          IF execution_time_totals_array^ [index_array^ [i]].
                block_total < execution_time_totals_array^ [index_array^ [i + 1]].block_total THEN
            number_of_changes := i - 1;
            temporary_index_array_entry := index_array^ [i];
            index_array^ [i] := index_array^ [i + 1];
            index_array^ [i + 1] := temporary_index_array_entry;
          IFEND;
        FOREND;
      UNTIL number_of_changes <= 0;

    PROCEND sort_by_time;
?? OLDTITLE ??
?? NEWTITLE := '    display_profile' ??
?? EJECT ??

    PROCEDURE display_profile
      (    index_array: ^array [0 .. * ] of pmt$block_id;
           number_to_print: integer;
           block_name_array: ^array [0 .. * ] of pmt$block_name_map_entry;
           execution_time_totals: ^array [0 .. * ] of pmt$execution_time_totals;
       VAR status: ost$status);

      VAR
        i,
        block_percentage,
        block_percentage_fraction,
        block_chargeback_percentage,
        blk_chargeback_percent_fraction,
        pages_in_chargeback,
        pages_in_chargeback_fraction,
        pages_reclaimed_chargeback,
        pages_reclaimed_fraction,
        new_pages_chargeback,
        new_pages_chargeback_fraction,
        total_pages_in,
        total_pages_reclaimed,
        total_new_pages,
        block_execution_time_in_seconds,
        current_index_array,
        how_many_to_print,
        block_execution_time_fraction: integer,
        block_chargeback_overflow: boolean,
        block_percentage_overflow: boolean,
        index: string (3),
        profile_template: [STATIC] string (120) := '                                                         '
              CAT '                  .             .               .             ',
        page_info_template: [STATIC] string (120) := ' ';

      status.normal := TRUE;

      how_many_to_print := number_to_print;

    /find_display_code_76/
      FOR i := 1 TO number_to_print DO
        IF block_name_array^ [index_array^ [i]].procedure_name = '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' THEN
          IF number_to_print < UPPERBOUND (block_name_array^) THEN
            how_many_to_print := number_to_print + 1;
          IFEND;
          EXIT /find_display_code_76/;
        IFEND;
      FOREND /find_display_code_76/;

      i := 1;

      WHILE i <= how_many_to_print DO

        block_percentage_overflow := FALSE;
        block_chargeback_overflow := FALSE;
        current_index_array := index_array^ [i];

{     a check is made here to get rid of block_name_array elements which contain a string of display-code-76
{     characters, indicating that this element is not to be printed.  this has been intended to inhibit the
{     printing of the zero-th element of both the local_ and remote_block_name_map

        IF block_name_array^ [current_index_array].procedure_name <> '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' THEN
          IF block_name_array^ [current_index_array].module_name = '{** REMOTE_MODULE **}' THEN
            profile_template (40, 31) := '   {** REMOTE_MODULE **}       ';
          ELSE
            profile_template (40, 31) := block_name_array^ [current_index_array].module_name;
          IFEND;
          profile_template (5, 31) := block_name_array^ [current_index_array].procedure_name;
          block_percentage := ((execution_time_totals^ [current_index_array].block_total * 10000) DIV
                program_microsec_execution_time) DIV 100;
          IF (execution_time_totals^ [current_index_array].block_total < 100000000000000) THEN
            block_percentage_fraction := ((execution_time_totals^ [current_index_array].block_total *
                  100000) DIV program_microsec_execution_time) MOD 1000;
          ELSE
            block_percentage_overflow := TRUE;
          IFEND;

          IF block_percentage < 0 THEN
            profile_template (87, 3) := '000';
          ELSE
            clp$convert_integer_to_rjstring (block_percentage, 10, FALSE, ' ', profile_template (87, 3),
                  status);
            IF NOT status.normal THEN
              profile_template (87, 3) := '000';
            IFEND;
          IFEND;

          IF block_percentage_overflow THEN
            profile_template (91, 3) := '***';
          ELSEIF block_percentage_fraction < 0 THEN
            profile_template (91, 3) := '000';
          ELSE
            clp$convert_integer_to_rjstring (block_percentage_fraction, 10, FALSE, '0',
                  profile_template (91, 3), status);
            IF NOT status.normal THEN
              profile_template (91, 3) := '000';
            IFEND;
          IFEND;

          block_execution_time_in_seconds := (execution_time_totals^ [current_index_array].block_total DIV
                1000) DIV 1000;
          block_execution_time_fraction := (execution_time_totals^ [current_index_array].block_total MOD
                1000000);

          IF block_execution_time_in_seconds < 0 THEN
            profile_template (71, 5) := '00000';
          ELSE
            clp$convert_integer_to_rjstring (block_execution_time_in_seconds, 10, FALSE, ' ',
                  profile_template (71, 5), status);
            IF NOT status.normal THEN
              profile_template (71, 5) := '*****';
            IFEND;
          IFEND;

          IF block_execution_time_fraction < 0 THEN
            profile_template (77, 6) := '000000';
          ELSE
            clp$convert_integer_to_rjstring (block_execution_time_fraction, 10, FALSE, '0',
                  profile_template (77, 6), status);
            IF NOT status.normal THEN
              profile_template (77, 6) := '000000';
            IFEND;
          IFEND;

          clp$convert_integer_to_rjstring (execution_time_totals^ [current_index_array].number_of_calls, 10,
                FALSE, ' ', profile_template (112, 8), status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          IF block_name_array^ [current_index_array].module_name <> '{** REMOTE_MODULE **}' THEN
            profile_template (104, 1) := '.';
            block_chargeback_percentage := (((execution_time_totals^ [current_index_array].block_total +
                  execution_time_totals^ [current_index_array].remote_total) * 10000) DIV
                  program_microsec_execution_time) DIV 100;
            IF (execution_time_totals^ [current_index_array].remote_total < 100000000000000) AND
               (execution_time_totals^ [current_index_array].block_total < 100000000000000) AND
               ((execution_time_totals^ [current_index_array].block_total +
               execution_time_totals^ [current_index_array].remote_total) < 100000000000000) THEN
              blk_chargeback_percent_fraction := (((execution_time_totals^ [current_index_array].block_total +
                    execution_time_totals^ [current_index_array].remote_total) * 100000) DIV
                    program_microsec_execution_time) MOD 1000;
            ELSE
              block_chargeback_overflow := TRUE;
            IFEND;

            IF block_chargeback_percentage < 0 THEN
              profile_template (101, 3) := '000';
            ELSE
              clp$convert_integer_to_rjstring (block_chargeback_percentage, 10, FALSE, ' ',
                    profile_template (101, 3), status);
              IF NOT status.normal THEN
                profile_template (101, 3) := '000';
              IFEND;
            IFEND;

            IF block_chargeback_overflow THEN
              profile_template (105, 3) := '***';
            ELSEIF blk_chargeback_percent_fraction < 0 THEN
              profile_template (105, 3) := '000';
            ELSE
              clp$convert_integer_to_rjstring (blk_chargeback_percent_fraction, 10, FALSE, '0',
                    profile_template (105, 3), status);
              IF NOT status.normal THEN
                profile_template (105, 3) := '000';
              IFEND;
            IFEND;
          ELSE
            profile_template (101, 10) := '          ';
          IFEND;


          clp$put_display (display_control, profile_template, clc$no_trim, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          clp$convert_integer_to_rjstring (execution_time_totals^ [current_index_array].block_paging_total.
                page_in_count, 10, FALSE, ' ', page_info_template (45, 8), status);
          IF NOT status.normal THEN
            page_info_template (48, 8) := '000';
          IFEND;

          clp$convert_integer_to_rjstring (execution_time_totals^ [current_index_array].block_paging_total.
                pages_reclaimed_from_queue, 10, FALSE, ' ', page_info_template (75, 8), status);
          IF NOT status.normal THEN
            page_info_template (76, 8) := '000';
          IFEND;

          clp$convert_integer_to_rjstring (execution_time_totals^ [current_index_array].block_paging_total.
                new_pages_assigned, 10, FALSE, ' ', page_info_template (100, 8), status);
          IF NOT status.normal THEN
            page_info_template (103, 8) := '000';
          IFEND;

          IF block_name_array^ [current_index_array].module_name <> '{** REMOTE_MODULE **}' THEN
            page_info_template (64, 1) := '.';
            page_info_template (90, 1) := '.';
            page_info_template (116, 1) := '.';

            total_pages_in := total_local_pages_in + total_remote_pages_in;
            IF total_pages_in <= 0 THEN
              page_info_template (61, 3) := '000';
            ELSE
              pages_in_chargeback := (((execution_time_totals^ [current_index_array].block_paging_total.
                    page_in_count + execution_time_totals^ [current_index_array].remote_paging_total.
                    page_in_count) * 10000) DIV total_pages_in) DIV 100;

              pages_in_chargeback_fraction := (((execution_time_totals^ [current_index_array].
                    block_paging_total.page_in_count + execution_time_totals^ [current_index_array].
                    remote_paging_total.page_in_count) * 100000) DIV total_pages_in) MOD 1000;

              IF pages_in_chargeback < 0 THEN
                page_info_template (61, 3) := '000';
              ELSE
                clp$convert_integer_to_rjstring (pages_in_chargeback, 10, FALSE, ' ',
                      page_info_template (61, 3), status);
                IF NOT status.normal THEN
                  page_info_template (61, 3) := '000';
                IFEND;
              IFEND;

              IF pages_in_chargeback_fraction < 0 THEN
                page_info_template (65, 3) := '000';
              ELSE
                clp$convert_integer_to_rjstring (pages_in_chargeback_fraction, 10, FALSE, '0',
                      page_info_template (65, 3), status);
                IF NOT status.normal THEN
                  page_info_template (65, 3) := '000';
                IFEND;
              IFEND;
            IFEND;

            total_pages_reclaimed := total_local_pages_reclaimed + total_remote_pages_reclaimed;
            IF total_pages_reclaimed <= 0 THEN
              page_info_template (87, 3) := '000';
            ELSE
              pages_reclaimed_chargeback := (((execution_time_totals^ [current_index_array].
                    block_paging_total.pages_reclaimed_from_queue +
                    execution_time_totals^ [current_index_array].remote_paging_total.
                    pages_reclaimed_from_queue) * 10000) DIV total_pages_reclaimed) DIV 100;

              pages_reclaimed_fraction := (((execution_time_totals^ [current_index_array].block_paging_total.
                    pages_reclaimed_from_queue + execution_time_totals^ [current_index_array].
                    remote_paging_total.pages_reclaimed_from_queue) * 100000) DIV total_pages_reclaimed) MOD
                    1000;

              IF pages_reclaimed_chargeback < 0 THEN
                page_info_template (87, 3) := '000';
              ELSE
                clp$convert_integer_to_rjstring (pages_reclaimed_chargeback, 10, FALSE, ' ',
                      page_info_template (87, 3), status);
                IF NOT status.normal THEN
                  page_info_template (87, 3) := '000';
                IFEND;
              IFEND;

              IF pages_reclaimed_fraction < 0 THEN
                page_info_template (91, 3) := '000';
              ELSE
                clp$convert_integer_to_rjstring (pages_reclaimed_fraction, 10, FALSE, '0',
                      page_info_template (91, 3), status);
                IF NOT status.normal THEN
                  page_info_template (91, 3) := '000';
                IFEND;
              IFEND;
            IFEND;

            total_new_pages := total_local_new_pages + total_remote_new_pages;
            IF total_new_pages <= 0 THEN
              page_info_template (113, 3) := '000';
            ELSE
              new_pages_chargeback := (((execution_time_totals^ [current_index_array].block_paging_total.
                    new_pages_assigned + execution_time_totals^ [current_index_array].remote_paging_total.
                    new_pages_assigned) * 10000) DIV total_new_pages) DIV 100;

              new_pages_chargeback_fraction := (((execution_time_totals^ [current_index_array].
                    block_paging_total.new_pages_assigned + execution_time_totals^ [current_index_array].
                    remote_paging_total.new_pages_assigned) * 100000) DIV total_new_pages) MOD 1000;

              IF new_pages_chargeback < 0 THEN
                page_info_template (113, 3) := '000';
              ELSE
                clp$convert_integer_to_rjstring (new_pages_chargeback, 10, FALSE, ' ',
                      page_info_template (113, 3), status);
                IF NOT status.normal THEN
                  page_info_template (113, 3) := '000';
                IFEND;
              IFEND;

              IF new_pages_chargeback_fraction < 0 THEN
                page_info_template (117, 3) := '000';
              ELSE
                clp$convert_integer_to_rjstring (new_pages_chargeback_fraction, 10, FALSE, '0',
                      page_info_template (117, 3), status);
                IF NOT status.normal THEN
                  page_info_template (117, 3) := '000';
                IFEND;
              IFEND;
            IFEND;
          ELSE
            page_info_template (60, 8) := '        ';
            page_info_template (86, 8) := '        ';
            page_info_template (112, 8) := '        ';
          IFEND;

          clp$put_display (display_control, page_info_template, clc$no_trim, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          clp$new_display_line (display_control, 1, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

        IFEND;
        i := i + 1;
      WHILEND;

    PROCEND display_profile;
?? OLDTITLE ??
?? EJECT ??

    VAR
      time: ost$time,
      date: ost$date,
      i,
      j,
      program_total_execution_time,
      remote_block_total_percentage,
      remote_blk_tot_percent_fraction,
      total_page_faults,
      total_local_pages_in,
      total_local_pages_reclaimed,
      total_local_new_pages,
      total_local_page_faults,
      total_remote_pages_in,
      total_remote_pages_reclaimed,
      total_remote_new_pages,
      total_remote_page_faults,
      number_of_calls,
      program_tot_execution_fraction: integer,
      listable_name: amt$local_file_name,
      number_to_print: pmt$block_id,
      temp_string: ost$string,
      first_entry: boolean,
      number_of_local_program_units: [STATIC] string (41) := '   * NUMBER OF LOCAL PROGRAM UNITS = ',
      number_of_remote_program_units: [STATIC] string (42) := '   * NUMBER OF REMOTE PROGRAM UNITS = ',
      amount_to_print: [STATIC] string (28) := '   * NUMBER TO PRINT =      ',
      total_number_of_calls: [STATIC] string (45) := '   * TOTAL NUMBER OF CALLS = ',
      table_header: [STATIC] array [1 .. 3] of string (120) :=
            ['                                              ' CAT
            '                                                       BLOCK       NUMBER',
            '                                                                        EXECUTION    ' CAT
            '  BLOCK       CHARGEBACK      OF', '           PROGRAM_UNIT NAME                      MODULE' CAT
            ' NAME             TIME       PERCENTAGE    PERCENTAGE    CALLS'],
      table_header2: [STATIC] array [1 .. 3] of string (120) :=
            ['                                        ' CAT
            '                    BLOCK                      BLOCK                     BLOCK  ',
            '                                        ' CAT
            '      PAGES       CHARGEBACK      PAGES      CHARGEBACK       NEW     CHARGEBACK',
            '                                        ' CAT
            '        IN        PERCENTAGE    RECLAIMED    PERCENTAGE      PAGES    PERCENTAGE'],
      block_execution_time_in_seconds: [STATIC] integer := 0,
      last_module_name: [STATIC] pmt$program_name := osc$null_name,
      program_microsec_execution_time: integer,
      local_total: integer,
      remote_total: integer,
      underline: [STATIC] string (120) :=
            '____________________________________________________________________' CAT
            '____________________________________________________',
      number_of_collection_runs: [STATIC] string (45) := '   * NUMBER OF COLLECTION RUNS TO DATE =     ',
      initial_creation_date: [STATIC] string (37) := '   * INITIAL CREATION DATE =         ',
      total_program_execution_time: [STATIC] string (56) :=
            '   * TOTAL PROGRAM EXECUTION TIME =      .       SECONDS',
      remote_blk_total_percentage: [STATIC] string (45) := '   * REMOTE BLOCK TOTAL PERCENTAGE =    .   %',
      total_page_fault_line: [STATIC] string (35) := '   * TOTAL PAGE FAULTS =           ',
      total_local_page_in_count: [STATIC] string (42) := '   * TOTAL LOCAL PAGE IN COUNT =          ',
      total_local_page_reclaimed: [STATIC] string (55) := '   * TOTAL LOCAL PAGES RECLAIMED FROM QUEUE =' CAT
            '          ',
      total_local_new_page: [STATIC] string (47) := '   * TOTAL LOCAL NEW PAGES ASSIGNED =          ',
      total_remote_page_in_count: [STATIC] string (43) := '   * TOTAL REMOTE PAGE IN COUNT =          ',
      total_remote_page_reclaimed: [STATIC] string (56) :=
            '   * TOTAL REMOTE PAGES RECLAIMED FROM QUEUE =          ',
      total_remote_new_page: [STATIC] string (48) := '   * TOTAL REMOTE NEW PAGES ASSIGNED =          ',
      page_header: [STATIC] string (120) :=
            'MEASURE PROGRAM EXECUTION                                         ' CAT
            '                                             PAGE             ',
      profile_sorted_by: [STATIC] string (45) := '   * PROFILE SORTED BY                      ',
      target_text: [STATIC] string (51) := '   * TARGET TEXT =                                ',
      list_template: [STATIC] string (38) := '                                      ',
      starting_procedure: [STATIC] string (59) :=
            '   * STARTING PROCEDURE =                                  ',
      small_underline: [STATIC] string (18) := '     ------------',
      object_files: [STATIC] string (18) := '   * OBJECT FILES',
      modules: [STATIC] string (13) := '   * MODULES',
      libraries: [STATIC] string (15) := '   * LIBRARIES',
      stack_size: [STATIC] string (29) := '   * STACK SIZE =            ',
      object_file_list: ^pmt$object_file_list,
      module_list: ^pmt$module_list,
      object_library_list: ^pmt$object_library_list,
      program_attributes: ^pmt$program_attributes,
      pmv$loader_description: [XREF] pmt$loader_description,
      block_name_array: ^array [0 .. * ] of pmt$block_name_map_entry,
      execution_time_totals_array: ^array [0 .. * ] of pmt$execution_time_totals,
      index_array: ^array [0 .. * ] of pmt$block_id,
      display_control: clt$display_control;


    first_entry := TRUE;

    IF pmv$mpe_seq_descriptor.local_execution_time_totals = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_no_execution_time_totals, '', status);
      RETURN;
    IFEND;

    remote_total := 0;
    local_total := 0;

    FOR i := 1 TO pmv$loader_seq_descriptor^.local_block_id DO
      local_total := local_total + pmv$mpe_seq_descriptor.local_execution_time_totals^ [i].block_total;
    FOREND;

    FOR i := 1 TO pmv$loader_seq_descriptor^.remote_block_id DO
      remote_total := remote_total + pmv$mpe_seq_descriptor.remote_execution_time_totals^ [i].block_total;
    FOREND;

    IF ((remote_total + local_total) = 0) THEN
      osp$set_status_abnormal ('PM', pme$e_no_execution_time_totals, '', status);
      RETURN;
    IFEND;

{   construct page header.

    pmp$get_legible_date_time (osc$mdy_date, date, osc$ampm_time, time, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    page_header (75, 8) := date.mdy;
    page_header (60, 8) := time.hms;

    pmp$get_os_version (page_header (30, 22), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{   print page header

    clp$open_display (output, ^new_page_proc, display_control, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{   print number of collection runs to date.

    clp$convert_integer_to_string (pmv$mpe_seq_descriptor.number_of_runs, 10, FALSE, temp_string, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    number_of_collection_runs (42, 3) := temp_string.value (1, temp_string.size);
    clp$put_display (display_control, number_of_collection_runs, clc$no_trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$new_display_line (display_control, 1, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{   print initial creation date.

    initial_creation_date (30, 8) := pmv$mpe_seq_descriptor.creation_date;
    clp$put_display (display_control, initial_creation_date, clc$no_trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$new_display_line (display_control, 1, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{   compute and print total program execution time.

    program_microsec_execution_time := remote_total + local_total;

{   convert time in microseconds to seconds for display.

    program_total_execution_time := (program_microsec_execution_time DIV 1000) DIV 1000;
    program_tot_execution_fraction := program_microsec_execution_time MOD 1000000;
    clp$convert_integer_to_rjstring (program_total_execution_time, 10, FALSE, ' ',
          total_program_execution_time (37, 5), status);
    IF NOT status.normal THEN
      total_program_execution_time (37, 5) := '*****';
    IFEND;
    clp$convert_integer_to_rjstring (program_tot_execution_fraction, 10, FALSE, '0',
          total_program_execution_time (43, 6), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$put_display (display_control, total_program_execution_time, clc$no_trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$new_display_line (display_control, 1, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{   compute and print remote block total percentage.

    remote_block_total_percentage := ((10000 * remote_total) DIV program_microsec_execution_time) DIV 100;
    remote_blk_tot_percent_fraction := ((100000 * remote_total) DIV program_microsec_execution_time) MOD 1000;


    clp$convert_integer_to_rjstring (remote_block_total_percentage, 10, FALSE, ' ',
          remote_blk_total_percentage (38, 3), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$convert_integer_to_rjstring (remote_blk_tot_percent_fraction, 10, FALSE, '0',
          remote_blk_total_percentage (42, 3), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$put_display (display_control, remote_blk_total_percentage, clc$no_trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$new_display_line (display_control, 1, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{   compute and print total paging statistics

    total_local_pages_in := 0;
    total_local_pages_reclaimed := 0;
    total_local_new_pages := 0;
    total_local_page_faults := 0;

    total_remote_pages_in := 0;
    total_remote_pages_reclaimed := 0;
    total_remote_new_pages := 0;
    total_remote_page_faults := 0;

    FOR i := 1 TO pmv$loader_seq_descriptor^.local_block_id DO
      total_local_pages_in := total_local_pages_in + pmv$mpe_seq_descriptor.local_execution_time_totals^ [i].
            block_paging_total.page_in_count;
      total_local_pages_reclaimed := total_local_pages_reclaimed +
            pmv$mpe_seq_descriptor.local_execution_time_totals^ [i].block_paging_total.
            pages_reclaimed_from_queue;
      total_local_new_pages := total_local_new_pages + pmv$mpe_seq_descriptor.
            local_execution_time_totals^ [i].block_paging_total.new_pages_assigned;
      total_local_page_faults := total_local_page_faults +
            pmv$mpe_seq_descriptor.local_execution_time_totals^ [i].block_paging_total.page_fault_count;
    FOREND;

    FOR i := 1 TO pmv$loader_seq_descriptor^.remote_block_id DO
      total_remote_pages_in := total_remote_pages_in + pmv$mpe_seq_descriptor.
            remote_execution_time_totals^ [i].block_paging_total.page_in_count;
      total_remote_pages_reclaimed := total_remote_pages_reclaimed +
            pmv$mpe_seq_descriptor.remote_execution_time_totals^ [i].block_paging_total.
            pages_reclaimed_from_queue;
      total_remote_new_pages := total_remote_new_pages + pmv$mpe_seq_descriptor.
            remote_execution_time_totals^ [i].block_paging_total.new_pages_assigned;
      total_remote_page_faults := total_remote_page_faults +
            pmv$mpe_seq_descriptor.remote_execution_time_totals^ [i].block_paging_total.page_fault_count;
    FOREND;

    total_page_faults := total_local_page_faults + total_remote_page_faults;

    clp$convert_integer_to_rjstring (total_page_faults, 10, FALSE, ' ', total_page_fault_line (26, 8),
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$put_display (display_control, total_page_fault_line, clc$no_trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$new_display_line (display_control, 1, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$convert_integer_to_rjstring (total_local_pages_in, 10, FALSE, ' ', total_local_page_in_count (33, 7),
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$put_display (display_control, total_local_page_in_count, clc$no_trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$new_display_line (display_control, 1, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$convert_integer_to_rjstring (total_local_pages_reclaimed, 10, FALSE, ' ',
          total_local_page_reclaimed (46, 7), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$put_display (display_control, total_local_page_reclaimed, clc$no_trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$new_display_line (display_control, 1, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$convert_integer_to_rjstring (total_local_new_pages, 10, FALSE, ' ', total_local_new_page (38, 7),
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$put_display (display_control, total_local_new_page, clc$no_trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$new_display_line (display_control, 1, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$convert_integer_to_rjstring (total_remote_pages_in, 10, FALSE, ' ',
          total_remote_page_in_count (34, 7), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$put_display (display_control, total_remote_page_in_count, clc$no_trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$new_display_line (display_control, 1, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$convert_integer_to_rjstring (total_remote_pages_reclaimed, 10, FALSE, ' ',
          total_remote_page_reclaimed (48, 8), status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$put_display (display_control, total_remote_page_reclaimed, clc$no_trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$new_display_line (display_control, 1, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$convert_integer_to_rjstring (total_remote_new_pages, 10, FALSE, ' ', total_remote_new_page (39, 7),
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$put_display (display_control, total_remote_new_page, clc$no_trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$new_display_line (display_control, 1, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{   print program description variables

    RESET pmv$program_description;
    NEXT program_attributes IN pmv$program_description;
    IF program_attributes = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
      RETURN;
    IFEND;

    IF pmc$starting_proc_specified IN program_attributes^.contents THEN
      starting_procedure (27, 31) := program_attributes^.starting_procedure;
      clp$put_display (display_control, starting_procedure, clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$new_display_line (display_control, 1, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    IF pmc$max_stack_size_specified IN program_attributes^.contents THEN
      clp$convert_integer_to_string (program_attributes^.maximum_stack_size, 10, FALSE, temp_string, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      stack_size (19, 10) := temp_string.value (1, temp_string.size);
      clp$put_display (display_control, stack_size, clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$new_display_line (display_control, 1, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    pmp$get_last_path_name (pmv$loader_description.target_text.local_file_name, listable_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    target_text (20, 31) := listable_name;
    clp$put_display (display_control, target_text, clc$trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$new_display_line (display_control, 1, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF pmc$object_file_list_specified IN program_attributes^.contents THEN
      NEXT object_file_list: [1 .. program_attributes^.number_of_object_files] IN pmv$program_description;
      clp$put_display (display_control, object_files, clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$put_display (display_control, small_underline, clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      FOR i := 1 TO program_attributes^.number_of_object_files DO
        pmp$get_last_path_name (object_file_list^ [i], listable_name, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        list_template (8, 31) := listable_name;
        clp$put_display (display_control, list_template, clc$trim, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND;
      clp$new_display_line (display_control, 1, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    IF pmc$module_list_specified IN program_attributes^.contents THEN
      NEXT module_list: [1 .. program_attributes^.number_of_modules] IN pmv$program_description;
      clp$put_display (display_control, modules, clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$put_display (display_control, small_underline, clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      FOR i := 1 TO program_attributes^.number_of_modules DO
        list_template (8, 31) := module_list^ [i];
        clp$put_display (display_control, list_template, clc$trim, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND;
      clp$new_display_line (display_control, 1, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    IF pmc$library_list_specified IN program_attributes^.contents THEN
      NEXT object_library_list: [1 .. program_attributes^.number_of_libraries] IN pmv$program_description;
      clp$put_display (display_control, libraries, clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$put_display (display_control, small_underline, clc$trim, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      FOR i := 1 TO program_attributes^.number_of_libraries DO
        pmp$get_last_path_name (object_library_list^ [i], listable_name, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        list_template (8, 31) := listable_name;
        clp$put_display (display_control, list_template, clc$trim, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND;
      clp$new_display_line (display_control, 1, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;


    CASE procedures OF

    = pmc$all =

{     the zero-th element of the local_block_name_map array and the local_execution_time_totals
{     array will be set to a string of display-code-76 characters (~) to facilitate checking
{     for these elements in the display_profile proc so that they will not be printed.

      pmv$loader_seq_descriptor^.local_block_name_map^ [0].procedure_name :=
            '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~';
      RESET pmv$loader_seq_descriptor^.seq_ptr TO pmv$loader_seq_descriptor^.remote_block_name_map;
      NEXT block_name_array: [0 .. (pmv$loader_seq_descriptor^.local_block_id +
            pmv$loader_seq_descriptor^.remote_block_id + 1)] IN pmv$loader_seq_descriptor^.seq_ptr;

      pmv$mpe_seq_descriptor.local_execution_time_totals^ [0].block_total := 0;
      RESET pmv$mpe_seq_descriptor.seq_ptr TO pmv$mpe_seq_descriptor.remote_execution_time_totals;
      NEXT execution_time_totals_array: [0 .. (pmv$loader_seq_descriptor^.local_block_id +
            pmv$loader_seq_descriptor^.remote_block_id + 1)] IN pmv$mpe_seq_descriptor.seq_ptr;

    = pmc$local =

      block_name_array := pmv$loader_seq_descriptor^.local_block_name_map;
      execution_time_totals_array := pmv$mpe_seq_descriptor.local_execution_time_totals;

    = pmc$remote =

      block_name_array := pmv$loader_seq_descriptor^.remote_block_name_map;
      execution_time_totals_array := pmv$mpe_seq_descriptor.remote_execution_time_totals;

    CASEND;

    PUSH index_array: [0 .. UPPERBOUND (block_name_array^)];
    FOR i := 1 TO UPPERBOUND (block_name_array^) DO
      index_array^ [i] := i;
    FOREND;

{   print the number of local program units and the number of remote program units.

    clp$convert_integer_to_string (pmv$loader_seq_descriptor^.local_block_id, 10, FALSE, temp_string, status);
    IF NOT status.normal THEN
      number_of_local_program_units (38, 4) := '****';
    ELSE
      number_of_local_program_units (38, 4) := temp_string.value (1, temp_string.size);
    IFEND;
    clp$put_display (display_control, number_of_local_program_units, clc$trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$new_display_line (display_control, 1, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$convert_integer_to_string (pmv$loader_seq_descriptor^.remote_block_id, 10, FALSE, temp_string,
          status);
    IF NOT status.normal THEN
      number_of_remote_program_units (39, 4) := '****';
    ELSE
      number_of_remote_program_units (39, 4) := temp_string.value (1, temp_string.size);
    IFEND;
    clp$put_display (display_control, number_of_remote_program_units, clc$trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$new_display_line (display_control, 1, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{   print the total number of procedure calls for the measured program.

    number_of_calls := 0;

    FOR i := 1 TO pmv$loader_seq_descriptor^.remote_block_id DO
      number_of_calls := number_of_calls + pmv$mpe_seq_descriptor.remote_execution_time_totals^ [i].
            number_of_calls;
    FOREND;
    FOR i := 1 TO pmv$loader_seq_descriptor^.local_block_id DO
      number_of_calls := number_of_calls + pmv$mpe_seq_descriptor.local_execution_time_totals^ [i].
            number_of_calls;
    FOREND;

    clp$convert_integer_to_string (number_of_calls, 10, FALSE, temp_string, status);
    IF NOT status.normal THEN
      total_number_of_calls (30, 16) := '****************';
    ELSE
      total_number_of_calls (30, 16) := temp_string.value (1, temp_string.size);
    IFEND;
    clp$put_display (display_control, total_number_of_calls, clc$trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$new_display_line (display_control, 1, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    CASE profile_order OF

    = pmc$module_procedure =
      sort_by_module_procedure (block_name_array, index_array);
      profile_sorted_by (24, 21) := 'MODULE-PROGRAM_UNIT  ';

    = pmc$procedure =
      sort_by_procedure (block_name_array, index_array);
      profile_sorted_by (24, 21) := 'PROGRAM_UNIT         ';

    = pmc$time =
      sort_by_time (execution_time_totals_array, index_array);
      profile_sorted_by (24, 21) := 'TIME                 ';

    CASEND;

    clp$put_display (display_control, profile_sorted_by, clc$trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$new_display_line (display_control, 1, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    number_to_print := number;
    IF (number_to_print > UPPERBOUND (block_name_array^)) AND (procedures = pmc$all) THEN
      number_to_print := UPPERBOUND (block_name_array^) - 1;
    ELSEIF number_to_print > UPPERBOUND (block_name_array^) THEN
      number_to_print := UPPERBOUND (block_name_array^);
    IFEND;

    clp$convert_integer_to_string (number_to_print, 10, FALSE, temp_string, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    amount_to_print (24, 4) := temp_string.value (1, temp_string.size);
    clp$put_display (display_control, amount_to_print, clc$trim, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF number_to_print <> 0 THEN

      clp$new_display_line (display_control, 2, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF ((display_control.line_number + 11) > display_control.page_length) AND
            (display_control.page_format <> amc$continuous_form) THEN
        clp$new_display_page (display_control, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      ELSE
        FOR i := 1 TO 3 DO
          clp$put_display (display_control, table_header [i], clc$no_trim, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        FOREND;
        FOR i := 1 TO 3 DO
          clp$put_display (display_control, table_header2 [i], clc$no_trim, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        FOREND;
        clp$put_display (display_control, underline, clc$no_trim, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        clp$new_display_line (display_control, 1, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

      display_profile (index_array, number_to_print, block_name_array, execution_time_totals_array, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;


    IFEND;

    clp$close_display (display_control, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND pmp$display_program_profile;

MODEND pmm$analyze_program_dynamics;
