?? RIGHT := 110 ??
*copy OSD$DEFAULT_PRAGMATS
?? NEWTITLE := 'NOS/VE:  MPE : Measure Program Execution Command Handlers', EJECT ??
MODULE pmm$mpe_command_handlers;



{ PURPOSE:                                                 }
{  Command processors for Measure Program Execution. }






{ *callc clxspl  }
{ *callc clxtpar }
{ *callc clxgsc  }
{ *callc clxgvc  }
{ *callc clxgval }
{ *callc clxpuut }
{ *callc clxscmf }
{ *callc clxexcf }
{ *callc clxpout }
{ *callc clxgpd  }

{ *callc pmxgdat }
{ *callc pmxunam }

{ *callc cldsfn  }
{ *callc cldescl }
{ *callc cldeere }

{ *callc osdhrdw }
{ *callc osdpgsz }
{ *callc osdptbl }

{ *callc amxclse }
{ *callc amxgsgp }
{ *callc amxsete }
{ *callc amxfile }

{ *callc osxssa  }
{ *callc osxasp  }

{ *callc ocxcpn  }
{ *callc ocxcts  }
{ *callc ocxgmsg }

{ *callc lldprgx }
{ *callc pmdaper }
{ *callc pmdapd  }
?? SET (LIST := OFF) ??

*copyc amt$access_selection
*copyc CLP$SCAN_PARAMETER_LIST
*copyc CLP$TEST_PARAMETER
*copyc CLP$EVALUATE_PARAMETERS
*copyc CLP$GET_SET_COUNT
*copyc CLP$GET_VALUE_COUNT
*copyc CLP$GET_VALUE
*copyc CLP$PUSH_UTILITY
*copyc CLP$SCAN_COMMAND_FILE
*copyc CLP$END_SCAN_COMMAND_FILE
*copyc CLP$POP_UTILITY
*copyc CLP$GET_PATH_DESCRIPTION

*copyc PMP$GET_DATE
*copyc pmp$get_unique_name

*copyc CLC$STANDARD_FILE_NAMES
*copyc CLE$ECC_MISCELLANEOUS
*copyc CLE$ECC_EXPRESSION_RESULT
*copyc OSD$INTEGER_LIMITS
*copyc OST$HARDWARE_SUBRANGES
*copyc OST$PAGE_SIZE
*copyc OST$PAGE_TABLE

*copyc AMP$GET_SEGMENT_POINTER
*copyc AMP$SET_SEGMENT_EOI
*copyc AMP$FILE
*copyc AMP$RETURN
*copyc FSP$CLOSE_FILE
*copyc FSP$OPEN_FILE

*copyc OSP$SET_STATUS_ABNORMAL
*copyc OSP$APPEND_STATUS_PARAMETER

*copyc OCP$CRACK_PROGRAM_NAME
*copyc OCP$CREATE_TRANSIENT_SEGMENT
*copyc OCP$GENERATE_MESSAGE
*copyc PMP$DISESTABLISH_END_HANDLER
*copyc PMP$ESTABLISH_END_HANDLER
*copyc LLT$PROGRAM_DESCRIPTION
*copyc PME$ANALYZE_PROGRAM_DYNAMICS
*copyc PMT$LOADER_SEQ_DESCRIPTOR

  PROCEDURE [XREF] pmp$restore_program_measures (measures: amt$local_file_name;
    VAR status: ost$status);

  PROCEDURE [XREF] pmp$execute_instrumented_task (execute_parameter_list: ^clt$parameter_list;
        no_connectivity_matrix: boolean;
        working_set_interval: 0 .. 0ffffffff(16);
    VAR status: ost$status);

  PROCEDURE [XREF] pmp$save_program_measures (measures: amt$local_file_name;
        environment_contents: pmt$environment_contents;
    VAR status: ost$status);

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

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

  PROCEDURE [XREF] pmp$display_program_profile (profile_order: pmt$profile_order;
        procedures: pmt$procedures;
        number: 0 .. 0ffffffff(16);
        output: clt$file;
    VAR status: ost$status);
?? SET (LIST := ON) ??
?? NEWTITLE := '  Global Variables', EJECT ??

  SECTION
    file_attributes: READ;

  VAR
    pmv$program_description: [XDCL] ^pmt$program_description,
    pmv$loader_seq_descriptor: [XDCL] ^pmt$loader_seq_descriptor,
    pmv$mpe_seq_descriptor: [XDCL] pmt$mpe_seq_descriptor,
    pmv$loader_description: [XDCL] pmt$loader_description,
    pmv$interblock_references_hdr: [XDCL] ^pmt$interblock_references_hdr,
    command_file: [STATIC] amt$local_file_name := clc$current_command_input;

  VAR
    work_file_attachment: [STATIC, READ, file_attributes] array [1 .. 1] of fst$attachment_option :=
          [[fsc$access_and_share_modes, [fsc$specific_access_modes, [fsc$read, fsc$append, fsc$modify,
          fsc$shorten]], [fsc$determine_from_access_modes]]],
    work_file_attributes: [STATIC, READ, file_attributes] array [1 .. 3] of fst$file_cycle_attribute :=
          [[fsc$file_contents_and_processor, fsc$data, fsc$unknown_processor],
          [fsc$file_organization, amc$sequential], [fsc$record_type, amc$undefined]];

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

{ PURPOSE:
{   The purpose of this request is to perform termination processing if
{   the MEASURE_PROGRAM_EXECUTION utility aborts.

  PROCEDURE end_handler
    (    termination_status: ost$status;
     VAR status: ost$status);

    VAR
      ignore_status: ost$status;

    status.normal := TRUE;

    release_files (ignore_status);

  PROCEND end_handler;
?? OLDTITLE ??
?? NEWTITLE := '  init_loader_seq_descriptor', EJECT ??

  PROCEDURE init_loader_seq_descriptor;

    IF pmv$loader_seq_descriptor <> NIL THEN
      pmv$loader_seq_descriptor^.block_name_map_exists := FALSE;
      pmv$loader_seq_descriptor^.local_block_id := 0;
      pmv$loader_seq_descriptor^.remote_block_id := 0;
      pmv$loader_seq_descriptor^.local_block_name_map := NIL;
      pmv$loader_seq_descriptor^.remote_block_name_map := NIL;
      pmv$loader_seq_descriptor^.number_of_interblock_segments := 1;
    IFEND;

  PROCEND init_loader_seq_descriptor;
?? OLDTITLE ??
?? NEWTITLE := '  init_interblock_references_hdr', EJECT ??

  PROCEDURE init_interblock_references_hdr;

    IF pmv$interblock_references_hdr <> NIL THEN
      pmv$interblock_references_hdr^.number_of_interblock_references := 0;
      pmv$interblock_references_hdr^.next_segment_file_name := osc$null_name;
    IFEND;

  PROCEND init_interblock_references_hdr;
?? OLDTITLE ??
?? NEWTITLE := '  init_mpe_seq_descriptor', EJECT ??

  PROCEDURE init_mpe_seq_descriptor;

    pmv$program_description := NIL;

    pmv$mpe_seq_descriptor.local_execution_time_totals := NIL;
    pmv$mpe_seq_descriptor.remote_execution_time_totals := NIL;
    pmv$mpe_seq_descriptor.connectivity_matrix := NIL;
    pmv$mpe_seq_descriptor.intercolumn_bond_matrix := NIL;

  PROCEND init_mpe_seq_descriptor;
?? OLDTITLE ??
?? NEWTITLE := '  release_files', EJECT ??

{ PURPOSE:
{   The purpose of this request is to release all temporary files used by
{   the MEASURE_PROGRAM_EXECUTION utility.

  PROCEDURE release_files
    (VAR status: ost$status);

    VAR
      ignore_status: ost$status;

    status.normal := TRUE;

    IF pmv$loader_seq_descriptor <> NIL THEN
      IF pmv$interblock_references_hdr <> NIL THEN
        fsp$close_file (pmv$interblock_references_hdr^.file_id, ignore_status);
        pmv$interblock_references_hdr := NIL;
      IFEND;
      release_interblock_segments (ignore_status);
      fsp$close_file (pmv$loader_seq_descriptor^.file_id, ignore_status);
      pmv$loader_seq_descriptor := NIL;
    IFEND;
    amp$return (pmv$loader_description.mpe_loader_seq, ignore_status);

  PROCEND release_files;
?? OLDTITLE ??
?? NEWTITLE := '  release_interblock_segments', EJECT ??

{ PURPOSE:
{   The purpose of this request is to release the temporary files used to
{   record the interblock references made by the program being analyzed.
{
{ NOTES:
{   All of the interblock reference files are assumed to be closed upon
{   entry.  The loader sequence file is assumed to be open.

  PROCEDURE release_interblock_segments
    (VAR status: ost$status);

    VAR
      file_id: amt$file_identifier,
      ignore_status: ost$status,
      next_file_name: amt$local_file_name,
      next_file_opened: boolean,
      previous_file_name: amt$local_file_name,
      previous_file_opened: boolean,
      segment: ost$positive_integers,
      segment_pointer: amt$segment_pointer;

    status.normal := TRUE;

    IF pmv$loader_seq_descriptor <> NIL THEN
      IF pmv$loader_seq_descriptor^.number_of_interblock_segments = 1 THEN
        amp$return (pmv$loader_seq_descriptor^.first_interblock_segment_name, ignore_status);
        RETURN;
      IFEND;
      next_file_name := pmv$loader_seq_descriptor^.first_interblock_segment_name;
      next_file_opened := FALSE;
      previous_file_opened := FALSE;

    /release_segments/
      FOR segment := 1 TO pmv$loader_seq_descriptor^.number_of_interblock_segments DO

        IF next_file_name <> osc$null_name THEN
          fsp$open_file (next_file_name, amc$segment, ^work_file_attachment, NIL, NIL, ^work_file_attributes,
                NIL, file_id, status);
          IF NOT status.normal THEN
            EXIT /release_segments/;
          IFEND;

          next_file_opened := TRUE;
          amp$get_segment_pointer (file_id, amc$sequence_pointer, segment_pointer, status);
          IF NOT status.normal THEN
            EXIT /release_segments/;
          IFEND;

          IF previous_file_opened THEN
            fsp$close_file (pmv$interblock_references_hdr^.file_id, ignore_status);
            amp$return (previous_file_name, ignore_status);
            previous_file_opened := FALSE;
          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);
            EXIT /release_segments/;
          IFEND;

          pmv$interblock_references_hdr^.file_id := file_id;
          previous_file_name := next_file_name;
          previous_file_opened := TRUE;
          next_file_name := pmv$interblock_references_hdr^.next_segment_file_name;
          next_file_opened := FALSE;
        IFEND;
      FOREND /release_segments/;

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

  PROCEND release_interblock_segments;
?? OLDTITLE ??
?? NEWTITLE := '  set_program_description', EJECT ??

  PROCEDURE set_program_description (parameter_list: clt$parameter_list;
    VAR status: ost$status);


{ pdt setpd_pdt (
{   target_text, tt: file = $required
{   file, files, f: list of file
{   library, libraries, l: list of file
{   module, modules, m: list of any
{   starting_procedure, sp: any
{   stack_size, ss: integer 1 .. osc$max_segment_length = 2000000
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      setpd_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^setpd_pdt_names,
        ^setpd_pdt_params];

    VAR
      setpd_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 16] of
        clt$parameter_name_descriptor := [['TARGET_TEXT', 1], ['TT', 1], ['FILE', 2], ['FILES', 2], ['F', 2],
        ['LIBRARY', 3], ['LIBRARIES', 3], ['L', 3], ['MODULE', 4], ['MODULES', 4], ['M', 4], [
        'STARTING_PROCEDURE', 5], ['SP', 5], ['STACK_SIZE', 6], ['SS', 6], ['STATUS', 7]];

    VAR
      setpd_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 7] of clt$parameter_descriptor := [

{ TARGET_TEXT TT }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ FILE FILES F }
      [[clc$optional], 1, clc$max_value_sets, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ LIBRARY LIBRARIES L }
      [[clc$optional], 1, clc$max_value_sets, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ MODULE MODULES M }
      [[clc$optional], 1, clc$max_value_sets, 1, 1, clc$value_range_not_allowed, [NIL, clc$any_value]],

{ STARTING_PROCEDURE SP }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$any_value]],

{ STACK_SIZE SS }
      [[clc$optional_with_default, ^setpd_pdt_dv6], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$integer_value, 1, osc$max_segment_length]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

    VAR
      setpd_pdt_dv6: [STATIC, READ, cls$pdt_names_and_defaults] string (7) := '2000000';

?? POP ??


    VAR
      parameter: clt$value,
      number_of_object_files: 0 .. clc$max_value_sets,
      number_of_files: 0 .. clc$max_value_sets,
      number_of_libraries: 0 .. clc$max_value_sets,
      number_of_modules: 0 .. clc$max_value_sets,
      i: 0 .. clc$max_value_sets,
      target_text_in_file_list: boolean,
      target_text: clt$file,
      module_name: pmt$program_name,
      size: integer,
      starting_proc: pmt$program_name,
      temp_program_description: ^pmt$program_description,
      program_attributes: ^pmt$program_attributes,
      object_file_list: ^pmt$object_file_list,
      module_list: ^pmt$module_list,
      object_library_list: ^pmt$object_library_list;

?? EJECT ??

    status.normal := TRUE;
    init_loader_seq_descriptor;
    init_interblock_references_hdr;
    init_mpe_seq_descriptor;

    clp$scan_parameter_list (parameter_list, setpd_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_set_count ('FILE', number_of_files, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF number_of_files = 0 THEN
      number_of_object_files := 1;
    ELSE
      number_of_object_files := number_of_files;
    IFEND;

    clp$get_set_count ('LIBRARY', number_of_libraries, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_set_count ('MODULE', number_of_modules, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    size := (#SIZE (pmt$program_attributes)) + (#SIZE (amt$local_file_name) * (number_of_libraries +
          number_of_object_files)) + (#SIZE (pmt$program_name) * number_of_modules);

    PUSH temp_program_description: [[REP size OF cell]];
    IF temp_program_description = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
      RETURN;
    IFEND;

    RESET temp_program_description;

    NEXT program_attributes IN temp_program_description;
    IF program_attributes = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
      RETURN;
    IFEND;
    program_attributes^.contents := $pmt$prog_description_contents [];

    clp$get_value ('TARGET_TEXT', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    target_text := parameter.file;
    target_text_in_file_list := FALSE;
?? EJECT ??

    program_attributes^.contents := program_attributes^.contents + $pmt$prog_description_contents
          [pmc$object_file_list_specified];
    program_attributes^.number_of_object_files := number_of_object_files;

    IF number_of_files <> 0 THEN
      NEXT object_file_list: [1 .. number_of_files] IN temp_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_files DO
        clp$get_value ('FILE', i, 1, clc$low, parameter, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        IF target_text.local_file_name = parameter.file.local_file_name THEN
          target_text_in_file_list := TRUE;
        IFEND;

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

      IF NOT target_text_in_file_list THEN
        osp$set_status_abnormal ('PM', pme$e_target_text_not_file, '', status);
        RETURN;
      IFEND;
    ELSE
      NEXT object_file_list: [1 .. 1] IN temp_program_description;
      IF object_file_list = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
        RETURN;
      IFEND;

      object_file_list^ [1] := target_text.local_file_name;
    IFEND;
?? EJECT ??

    IF number_of_modules <> 0 THEN
      program_attributes^.contents := program_attributes^.contents + $pmt$prog_description_contents
            [pmc$module_list_specified];
      program_attributes^.number_of_modules := number_of_modules;

      NEXT module_list: [1 .. number_of_modules] IN temp_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
        clp$get_value ('MODULES', i, 1, clc$low, parameter, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        ocp$crack_program_name ('MODULES', parameter, module_name, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        module_list^ [i] := module_name;
      FOREND;
    IFEND;

    IF number_of_libraries <> 0 THEN
      program_attributes^.contents := program_attributes^.contents + $pmt$prog_description_contents
            [pmc$library_list_specified];
      program_attributes^.number_of_libraries := number_of_libraries;

      NEXT object_library_list: [1 .. number_of_libraries] IN temp_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$get_value ('LIBRARY', i, 1, clc$low, parameter, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

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

    clp$get_value ('STARTING_PROCEDURE', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parameter.kind <> clc$unknown_value THEN
      program_attributes^.contents := program_attributes^.contents + $pmt$prog_description_contents
            [pmc$starting_proc_specified];

      ocp$crack_program_name ('STARTING_PROCEDURE', parameter, starting_proc, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      program_attributes^.starting_procedure := starting_proc;
    IFEND;

    clp$get_value ('STACK_SIZE', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    program_attributes^.contents := program_attributes^.contents + $pmt$prog_description_contents
          [pmc$max_stack_size_specified];
    program_attributes^.maximum_stack_size := parameter.int.value;

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

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

    pmv$program_description^ := temp_program_description^;

    pmv$loader_description.target_text := target_text;

  PROCEND set_program_description;
?? OLDTITLE ??
?? NEWTITLE := '  restore_program_measures', EJECT ??

  PROCEDURE restore_program_measures (parameter_list: clt$parameter_list;
    VAR status: ost$status);


{ pdt setpm_pdt (
{   measures, m: file = $required
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      setpm_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^setpm_pdt_names,
        ^setpm_pdt_params];

    VAR
      setpm_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of
        clt$parameter_name_descriptor := [['MEASURES', 1], ['M', 1], ['STATUS', 2]];

    VAR
      setpm_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 2] of clt$parameter_descriptor := [

{ MEASURES M }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

?? POP ??


    VAR
      parameter: clt$value;


    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, setpm_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('MEASURES', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pmp$restore_program_measures (parameter.file.local_file_name, status);
    IF NOT status.normal THEN
      init_loader_seq_descriptor;
      init_interblock_references_hdr;
      init_mpe_seq_descriptor;

      ocp$generate_message (status);

      status.normal := TRUE;

      osp$set_status_abnormal ('PM', pme$w_mpe_environment_restored, '', status);
      RETURN;
    IFEND;

  PROCEND restore_program_measures;
?? OLDTITLE ??
?? NEWTITLE := '  execute_instrumented_task', EJECT ??

  PROCEDURE execute_instrumented_task (parameter_list: clt$parameter_list;
    VAR status: ost$status);


{ procedure exeit_pdt (
{   parameter, p: string = ' '
{   no_connectivity_matrix, ncm: boolean = false
{   working_set_interval, wsi: integer 0 .. 0ffffffff(16) = 50000
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 7] of clt$pdt_parameter_name,
      parameters: array [1 .. 4] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (3),
      recend,
      type2: record
        header: clt$type_specification_header,
        default_value: string (5),
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
        default_value: string (5),
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [93, 10, 18, 0, 11, 45, 521],
    clc$command, 7, 4, 0, 0, 0, 0, 4, ''], [
    ['NCM                            ',clc$abbreviation_entry, 2],
    ['NO_CONNECTIVITY_MATRIX         ',clc$nominal_entry, 2],
    ['P                              ',clc$abbreviation_entry, 1],
    ['PARAMETER                      ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 4],
    ['WORKING_SET_INTERVAL           ',clc$nominal_entry, 3],
    ['WSI                            ',clc$abbreviation_entry, 3]],
    [
{ PARAMETER 1
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation,
  clc$standard_parameter_checking, 8, clc$optional_default_parameter, 0, 3],
{ PARAMETER 2
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation,
  clc$standard_parameter_checking, 3, clc$optional_default_parameter, 0, 5],
{ PARAMETER 3
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation,
  clc$standard_parameter_checking, 20, clc$optional_default_parameter, 0, 5],
{ PARAMETER 4
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation,
  clc$standard_parameter_checking, 3, clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$string_type], [0, clc$max_string_size, FALSE],
    ''' '''],
{ PARAMETER 2
    [[1, 0, clc$boolean_type],
    'false'],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [0, 0ffffffff(16), 10],
    '50000'],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];

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

    CONST
      p$parameter = 1,
      p$no_connectivity_matrix = 2,
      p$working_set_interval = 3,
      p$status = 4;

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

    VAR
      execute_parameter_list: ^clt$parameter_list,
      string_index: clt$string_size,
      strng: ^char,
      strng_length: ^clt$string_size,
      string_size: clt$string_size;

    status.normal := TRUE;

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

    string_size := STRLENGTH (pvt [p$parameter].value^.string_value^);
    PUSH execute_parameter_list: [[ clt$string_size, REP string_size OF char ]];
    RESET execute_parameter_list;

    NEXT strng_length IN execute_parameter_list;
    IF strng_length = NIL THEN
      osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
      RETURN;
    IFEND;
    strng_length^ := string_size;

    FOR string_index := 1 TO string_size DO
      NEXT strng IN execute_parameter_list;
      IF strng = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
        RETURN;
      IFEND;
      strng^ := pvt [p$parameter].value^.string_value^(string_index);
    FOREND;

    pmp$execute_instrumented_task (execute_parameter_list,
         pvt [p$no_connectivity_matrix].value^.boolean_value.value,
         pvt [p$working_set_interval].value^.integer_value.value,status);
    IF NOT status.normal THEN
      init_loader_seq_descriptor;
      init_interblock_references_hdr;

      ocp$generate_message (status);
      status.normal := TRUE;

      osp$set_status_abnormal ('PM', pme$w_mpe_environment_restored, '', status);

      RETURN;
    IFEND;

  PROCEND execute_instrumented_task;
?? OLDTITLE ??
?? NEWTITLE := '  save_program_measures', EJECT ??

  PROCEDURE save_program_measures (parameter_list: clt$parameter_list;
    VAR status: ost$status);


{ pdt coppm_pdt (
{   measures, m: file = $required
{   amount, a: list 1..2 of key all, connectivity_matrix, cm, execution_time_totals, ett = all
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      coppm_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^coppm_pdt_names,
        ^coppm_pdt_params];

    VAR
      coppm_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of
        clt$parameter_name_descriptor := [['MEASURES', 1], ['M', 1], ['AMOUNT', 2], ['A', 2], ['STATUS', 3]];

    VAR
      coppm_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 3] of clt$parameter_descriptor := [

{ MEASURES M }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ AMOUNT A }
      [[clc$optional_with_default, ^coppm_pdt_dv2], 1, 2, 1, 1, clc$value_range_not_allowed, [^coppm_pdt_kv2,
        clc$keyword_value]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

    VAR
      coppm_pdt_kv2: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of ost$name := ['ALL',
        'CONNECTIVITY_MATRIX', 'CM', 'EXECUTION_TIME_TOTALS', 'ETT'];

    VAR
      coppm_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (3) := 'all';

?? POP ??


    VAR
      number_of_sets: 0 .. clc$max_value_sets,
      i: 0 .. clc$max_value_sets,
      environment_contents: pmt$environment_contents,
      measures: amt$local_file_name,
      parameter: clt$value;


    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, coppm_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('MEASURES', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    measures := parameter.file.local_file_name;

    clp$get_set_count ('AMOUNT', number_of_sets, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    environment_contents := $pmt$environment_contents [];

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

    IF NOT pmv$loader_seq_descriptor^.block_name_map_exists THEN
      osp$set_status_abnormal ('PM', pme$e_no_block_name_map, '', status);
      RETURN;
    IFEND;
?? EJECT ??

    FOR i := 1 TO number_of_sets DO
      clp$get_value ('AMOUNT', i, 1, clc$low, parameter, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF parameter.name.value = 'ALL' THEN
        IF number_of_sets = 1 THEN
          IF pmv$mpe_seq_descriptor.local_execution_time_totals <> NIL THEN
            environment_contents := environment_contents + $pmt$environment_contents
                  [pmc$execution_time_totals];
          IFEND;

          IF pmv$mpe_seq_descriptor.connectivity_matrix <> NIL THEN
            environment_contents := environment_contents + $pmt$environment_contents
                  [pmc$connectivity_matrix];
          IFEND;
        ELSE
          osp$set_status_abnormal ('PM', cle$all_must_be_used_alone, 'AMOUNT', status);
          RETURN;
        IFEND;
      ELSEIF (parameter.name.value = 'CONNECTIVITY_MATRIX') OR (parameter.name.value = 'CM') THEN
        IF pmv$mpe_seq_descriptor.connectivity_matrix = NIL THEN
          osp$set_status_abnormal ('PM', pme$e_no_connectivity_matrix, '', status);
          RETURN;
        IFEND;

        environment_contents := environment_contents + $pmt$environment_contents [pmc$connectivity_matrix];
      ELSEIF (parameter.name.value = 'EXECUTION_TIME_TOTALS') OR (parameter.name.value = 'ETT') THEN
        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;

        environment_contents := environment_contents + $pmt$environment_contents [pmc$execution_time_totals];
      IFEND;
    FOREND;

    pmp$save_program_measures (measures, environment_contents, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND save_program_measures;
?? OLDTITLE ??
?? NEWTITLE := '  create_restructure_commands', EJECT ??

  PROCEDURE create_restructuring_commands (parameter_list: clt$parameter_list;
    VAR status: ost$status);


{ pdt crerc_pdt (
{   restructuring_commands, rc: file = $required
{   restructured_module, rm: file = $required
{   restructured_module_name, rmn: any
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      crerc_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^crerc_pdt_names,
        ^crerc_pdt_params];

    VAR
      crerc_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 7] of
        clt$parameter_name_descriptor := [['RESTRUCTURING_COMMANDS', 1], ['RC', 1], ['RESTRUCTURED_MODULE',
        2], ['RM', 2], ['RESTRUCTURED_MODULE_NAME', 3], ['RMN', 3], ['STATUS', 4]];

    VAR
      crerc_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 4] of clt$parameter_descriptor := [

{ RESTRUCTURING_COMMANDS RC }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ RESTRUCTURED_MODULE RM }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ RESTRUCTURED_MODULE_NAME RMN }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$any_value]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

?? POP ??


    VAR
      commands: amt$local_file_name,
      library: clt$file,
      file_reference: clt$file_reference,
      path_container: clt$path_container,
      path: ^pft$path,
      cycle_selector: clt$cycle_selector,
      open_position: clt$open_position,
      module_name: pmt$program_name,
      parameter: clt$value;


    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, crerc_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('RESTRUCTURING_COMMANDS', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    commands := parameter.file.local_file_name;

    clp$get_value ('RESTRUCTURED_MODULE', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    library := parameter.file;

    clp$get_value ('RESTRUCTURED_MODULE_NAME', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
?? EJECT ??

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

    IF parameter.kind <> clc$unknown_value THEN
      ocp$crack_program_name ('RESTRUCTURED_MODULE_NAME', parameter, module_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE
      module_name := path^ [UPPERBOUND (path^)];
    IFEND;

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

  PROCEND create_restructuring_commands;
?? OLDTITLE ??
?? NEWTITLE := '  create_restructured_module', EJECT ??

  PROCEDURE create_restructured_module (parameter_list: clt$parameter_list;
    VAR status: ost$status);


{ pdt crerm_pdt (
{   restructured_module, rm: file = $required
{   restructured_module_name, rmn: any
{   restructuring_commands, rc: file
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      crerm_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^crerm_pdt_names,
        ^crerm_pdt_params];

    VAR
      crerm_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 7] of
        clt$parameter_name_descriptor := [['RESTRUCTURED_MODULE', 1], ['RM', 1], ['RESTRUCTURED_MODULE_NAME',
        2], ['RMN', 2], ['RESTRUCTURING_COMMANDS', 3], ['RC', 3], ['STATUS', 4]];

    VAR
      crerm_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 4] of clt$parameter_descriptor := [

{ RESTRUCTURED_MODULE RM }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ RESTRUCTURED_MODULE_NAME RMN }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$any_value]],

{ RESTRUCTURING_COMMANDS RC }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

?? POP ??


    VAR
      return_attribute: [STATIC] array [1 .. 1] of amt$access_selection := [[amc$return_option,
        amc$return_at_task_exit]];


    VAR
      file_reference: clt$file_reference,
      path_container: clt$path_container,
      path: ^pft$path,
      cycle_selector: clt$cycle_selector,
      open_position: clt$open_position,
      library: clt$file,
      commands: amt$local_file_name,
      module_name: pmt$program_name,
      parameter: clt$value;


    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, crerm_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('RESTRUCTURED_MODULE', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    library := parameter.file;

    clp$get_value ('RESTRUCTURED_MODULE_NAME', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
?? EJECT ??

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

    IF parameter.kind <> clc$unknown_value THEN
      ocp$crack_program_name ('RESTRUCTURED_MODULE_NAME', parameter, module_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSE
      module_name := path^ [UPPERBOUND (path^)];
    IFEND;

    clp$get_value ('RESTRUCTURING_COMMANDS', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parameter.kind <> clc$unknown_value THEN
      commands := parameter.file.local_file_name;
    ELSE
      pmp$get_unique_name (commands, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      amp$file (commands, return_attribute, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

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

  PROCEND create_restructured_module;
?? OLDTITLE ??
?? NEWTITLE := '  display_program_profile', EJECT ??

  PROCEDURE display_program_profile (parameter_list: clt$parameter_list;
    VAR status: ost$status);


{ pdt dispp_pdt (
{   profile_order, po: key module_program_unit, mpu, program_unit, pu, time, t = time
{   program_unit_class, puc: key all, local, remote = all
{   number, n: integer 0 .. 0ffffffff(16) or key all = all
{   output, o: file = $OUTPUT
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      dispp_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^dispp_pdt_names,
        ^dispp_pdt_params];

    VAR
      dispp_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 9] of
        clt$parameter_name_descriptor := [['PROFILE_ORDER', 1], ['PO', 1], ['PROGRAM_UNIT_CLASS', 2], ['PUC',
        2], ['NUMBER', 3], ['N', 3], ['OUTPUT', 4], ['O', 4], ['STATUS', 5]];

    VAR
      dispp_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 5] of clt$parameter_descriptor := [

{ PROFILE_ORDER PO }
      [[clc$optional_with_default, ^dispp_pdt_dv1], 1, 1, 1, 1, clc$value_range_not_allowed, [^dispp_pdt_kv1,
        clc$keyword_value]],

{ PROGRAM_UNIT_CLASS PUC }
      [[clc$optional_with_default, ^dispp_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed, [^dispp_pdt_kv2,
        clc$keyword_value]],

{ NUMBER N }
      [[clc$optional_with_default, ^dispp_pdt_dv3], 1, 1, 1, 1, clc$value_range_not_allowed, [^dispp_pdt_kv3,
        clc$integer_value, 0, 0ffffffff(16)]],

{ OUTPUT O }
      [[clc$optional_with_default, ^dispp_pdt_dv4], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$file_value]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

    VAR
      dispp_pdt_kv1: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 6] of ost$name := [
        'MODULE_PROGRAM_UNIT', 'MPU', 'PROGRAM_UNIT', 'PU', 'TIME', 'T'];

    VAR
      dispp_pdt_kv2: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 3] of ost$name := ['ALL', 'LOCAL',
        'REMOTE'];

    VAR
      dispp_pdt_kv3: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1] of ost$name := ['ALL'];

    VAR
      dispp_pdt_dv1: [STATIC, READ, cls$pdt_names_and_defaults] string (4) := 'time';

    VAR
      dispp_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (3) := 'all';

    VAR
      dispp_pdt_dv3: [STATIC, READ, cls$pdt_names_and_defaults] string (3) := 'all';

    VAR
      dispp_pdt_dv4: [STATIC, READ, cls$pdt_names_and_defaults] string (7) := '$OUTPUT';

?? POP ??


    VAR
      parameter: clt$value,
      procedures: pmt$procedures,
      profile_order: pmt$profile_order,
      number: 0 .. 0ffffffff(16),
      output: clt$file;


    clp$scan_parameter_list (parameter_list, dispp_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$get_value ('PROFILE_ORDER', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF (parameter.name.value = 'MODULE_PROGRAM_UNIT') OR (parameter.name.value = 'MPU') THEN
      profile_order := pmc$module_procedure;
    ELSEIF (parameter.name.value = 'PROGRAM_UNIT') OR (parameter.name.value = 'PU') THEN
      profile_order := pmc$procedure;
    ELSEIF (parameter.name.value = 'TIME') OR (parameter.name.value = 'T') THEN
      profile_order := pmc$time;
    IFEND;

    clp$get_value ('PROGRAM_UNIT_CLASS', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parameter.name.value = 'ALL' THEN
      IF pmv$loader_seq_descriptor^.local_block_id = 0 THEN
        procedures := pmc$remote;
      ELSEIF pmv$loader_seq_descriptor^.remote_block_id = 0 THEN
        procedures := pmc$local;
      ELSE
        procedures := pmc$all;
      IFEND;
    ELSEIF parameter.name.value = 'LOCAL' THEN
      IF pmv$loader_seq_descriptor^.local_block_id = 0 THEN
        osp$set_status_abnormal ('PM', pme$e_no_local_program_units, '', status);
        RETURN;
      IFEND;
      procedures := pmc$local;
    ELSEIF parameter.name.value = 'REMOTE' THEN
      IF pmv$loader_seq_descriptor^.remote_block_id = 0 THEN
        osp$set_status_abnormal ('PM', pme$e_no_remote_program_units, '', status);
        RETURN;
      IFEND;
      procedures := pmc$remote;
    IFEND;

    clp$get_value ('NUMBER', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF parameter.kind = clc$integer_value THEN
      number := parameter.int.value;
    ELSE
      number := pmv$loader_seq_descriptor^.local_block_id + pmv$loader_seq_descriptor^.remote_block_id;
    IFEND;

    clp$get_value ('OUTPUT', 1, 1, clc$low, parameter, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    output := parameter.file;

    pmp$display_program_profile (profile_order, procedures, number, output, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND display_program_profile;
?? OLDTITLE ??
?? NEWTITLE := '  quit', EJECT ??

  PROCEDURE quit (parameter_list: clt$parameter_list;
    VAR status: ost$status);





{ pdt quit_pdt ()

?? PUSH (LISTEXT := ON) ??

    VAR
      quit_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [NIL, NIL];

?? POP ??


    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, quit_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$end_scan_command_file (mpe_utility_name, status);

  PROCEND quit;
?? OLDTITLE ??
?? NEWTITLE := '  pmp$measure_program_execution', EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$measure_program_execution (parameter_list: clt$parameter_list;
    VAR status: ost$status);




{ pdt meape_pdt (
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      meape_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^meape_pdt_names,
        ^meape_pdt_params];

    VAR
      meape_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 1] of
        clt$parameter_name_descriptor := [['STATUS', 1]];

    VAR
      meape_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 1] of clt$parameter_descriptor := [

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

?? POP ??

?? PUSH (LISTEXT := ON) ??

    VAR
      build_real_memory_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table :=
        [^build_real_memory_pdt_names, ^build_real_memory_pdt_params];

    VAR
      build_real_memory_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 2] of
        clt$parameter_name_descriptor := [['STATUS', 1], ['ST', 1]];

    VAR
      build_real_memory_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 1] of
        clt$parameter_descriptor := [

{ STATUS ST }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

?? POP ??
?? EJECT ??
{ table mpe_command_list t=c s=local
{   command (set_program_description        ,setpd) set_program_description cm=local
{   command (restore_program_measures       ,respm) restore_program_measures cm=local
{   command (execute_instrumented_task      ,exeit) execute_instrumented_task cm=local
{   command (save_program_measures          ,savpm) save_program_measures cm=local
{   command (create_restructuring_commands  ,crerc) create_restructuring_commands cm=local
{   command (create_restructured_module     ,crerm) create_restructured_module cm=local
{   command (display_program_profile        ,dispp) display_program_profile cm=local
{   command (quit                           ,qui) quit cm=local
{ tablend

?? PUSH (LISTEXT := ON) ??
VAR
  mpe_command_list: [STATIC, READ] ^clt$command_table :=
      ^mpe_command_list_entries,

  mpe_command_list_entries: [STATIC, READ] array [1 .. 16] of
      clt$command_table_entry := [
  {} ['CREATE_RESTRUCTURED_MODULE     ', clc$nominal_entry, clc$advertised_entry, 6,
        clc$automatically_log, clc$linked_call, ^create_restructured_module],
  {} ['CREATE_RESTRUCTURING_COMMANDS  ', clc$nominal_entry, clc$advertised_entry, 5,
        clc$automatically_log, clc$linked_call, ^create_restructuring_commands],
  {} ['CRERC                          ', clc$abbreviation_entry, clc$advertised_entry, 5,
        clc$automatically_log, clc$linked_call, ^create_restructuring_commands],
  {} ['CRERM                          ', clc$abbreviation_entry, clc$advertised_entry, 6,
        clc$automatically_log, clc$linked_call, ^create_restructured_module],
  {} ['DISPLAY_PROGRAM_PROFILE        ', clc$nominal_entry, clc$advertised_entry, 7,
        clc$automatically_log, clc$linked_call, ^display_program_profile],
  {} ['DISPP                          ', clc$abbreviation_entry, clc$advertised_entry, 7,
        clc$automatically_log, clc$linked_call, ^display_program_profile],
  {} ['EXECUTE_INSTRUMENTED_TASK      ', clc$nominal_entry, clc$advertised_entry, 3,
        clc$automatically_log, clc$linked_call, ^execute_instrumented_task],
  {} ['EXEIT                          ', clc$abbreviation_entry, clc$advertised_entry, 3,
        clc$automatically_log, clc$linked_call, ^execute_instrumented_task],
  {} ['QUI                            ', clc$abbreviation_entry, clc$advertised_entry, 8,
        clc$automatically_log, clc$linked_call, ^quit],
  {} ['QUIT                           ', clc$nominal_entry, clc$advertised_entry, 8,
        clc$automatically_log, clc$linked_call, ^quit],
  {} ['RESPM                          ', clc$abbreviation_entry, clc$advertised_entry, 2,
        clc$automatically_log, clc$linked_call, ^restore_program_measures],
  {} ['RESTORE_PROGRAM_MEASURES       ', clc$nominal_entry, clc$advertised_entry, 2,
        clc$automatically_log, clc$linked_call, ^restore_program_measures],
  {} ['SAVE_PROGRAM_MEASURES          ', clc$nominal_entry, clc$advertised_entry, 4,
        clc$automatically_log, clc$linked_call, ^save_program_measures],
  {} ['SAVPM                          ', clc$abbreviation_entry, clc$advertised_entry, 4,
        clc$automatically_log, clc$linked_call, ^save_program_measures],
  {} ['SETPD                          ', clc$abbreviation_entry, clc$advertised_entry, 1,
        clc$automatically_log, clc$linked_call, ^set_program_description],
  {} ['SET_PROGRAM_DESCRIPTION        ', clc$nominal_entry, clc$advertised_entry, 1,
        clc$automatically_log, clc$linked_call, ^set_program_description]];


?? POP ??
?? EJECT ??

    VAR
      attribute_validation: ^fst$file_cycle_attributes,
      ignore_status: ost$status,
      interblock_file_name: ost$name,
      interblock_file_opened: boolean,
      interblock_id: amt$file_identifier,
      loader_file_name: ost$name,
      loader_file_opened: boolean,
      loader_id: amt$file_identifier,
      parameter: clt$value,
      segment_pointer: amt$segment_pointer;

    status.normal := TRUE;
    interblock_file_name := osc$null_name;
    interblock_file_opened := FALSE;
    loader_file_opened := FALSE;
    pmv$interblock_references_hdr := NIL;
    pmv$loader_seq_descriptor := NIL;

    clp$scan_parameter_list (parameter_list, meape_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


    pmp$get_unique_name (loader_file_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pmv$loader_description.mpe_loader_seq := loader_file_name;
    pmv$loader_description.apd_load := TRUE;

  /establish_files/
    BEGIN
      fsp$open_file (loader_file_name, amc$segment, ^work_file_attachment, NIL, ^work_file_attributes, NIL,
            NIL, loader_id, status);
      IF NOT status.normal THEN
        EXIT /establish_files/;
      IFEND;

      loader_file_opened := TRUE;
      amp$get_segment_pointer (loader_id, amc$sequence_pointer, segment_pointer, status);
      IF NOT status.normal THEN
        EXIT /establish_files/;
      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_mpe_seg_overflow, '', status);
        EXIT /establish_files/;
      IFEND;

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

      pmp$get_unique_name (interblock_file_name, status);
      IF NOT status.normal THEN
        EXIT /establish_files/;
      IFEND;

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

{ Set the file limit to 2 GB.

      attribute_validation^ [4].selector := fsc$file_limit;
      attribute_validation^ [4].file_limit := 2000000000;

      fsp$open_file (interblock_file_name, amc$segment, ^work_file_attachment, NIL, attribute_validation,
            NIL, NIL, interblock_id, status);
      IF NOT status.normal THEN
        EXIT /establish_files/;
      IFEND;

      amp$get_segment_pointer (interblock_id, amc$sequence_pointer, segment_pointer, status);
      IF NOT status.normal THEN
        EXIT /establish_files/;
      IFEND;

      RESET segment_pointer.sequence_pointer;
      NEXT pmv$interblock_references_hdr IN segment_pointer.sequence_pointer;
      IF pmv$interblock_references_hdr = NIL THEN
        osp$set_status_abnormal ('PM', pme$e_internal_mpe_seg_overflow, '', status);
        EXIT /establish_files/;
      IFEND;

      pmv$interblock_references_hdr^.file_id := interblock_id;
      pmv$loader_seq_descriptor^.last_interblock_segment := segment_pointer.sequence_pointer;

      ocp$create_transient_segment (amc$sequence_pointer, segment_pointer, status);
      IF NOT status.normal THEN
        EXIT /establish_files/;
      IFEND;

      RESET segment_pointer.sequence_pointer;
      pmv$mpe_seq_descriptor.seq_ptr := segment_pointer.sequence_pointer;

      init_loader_seq_descriptor;
      init_interblock_references_hdr;
      init_mpe_seq_descriptor;
    END /establish_files/;

    IF NOT status.normal THEN
      IF interblock_file_name <> osc$null_name THEN
        IF interblock_file_opened THEN
          fsp$close_file (interblock_id, ignore_status);
        IFEND;
        amp$return (interblock_file_name, ignore_status);
      IFEND;
      IF loader_file_opened THEN
        fsp$close_file (loader_id, ignore_status);
      IFEND;
      amp$return (loader_file_name, ignore_status);
      RETURN;
    IFEND;

    pmp$establish_end_handler (^end_handler, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$push_utility (mpe_utility_name, clc$global_command_search, mpe_command_list, NIL, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$scan_command_file (command_file, mpe_utility_name, mpe_prompt_string, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    release_files (ignore_status);

    pmp$disestablish_end_handler (^end_handler, ignore_status);

    clp$pop_utility (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;


  PROCEND pmp$measure_program_execution;

MODEND pmm$mpe_command_handlers;

