?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE  Program Management : APD Miscellaneous routines' ??
?? NEWTITLE := '  PMM$MPE_RECORD_CALL_AND_RETURN' ??
MODULE pmm$mpe_record_call_and_return;
?? PUSH (LISTEXT := ON) ??
*copyc amt$file_identifier
*copyc amt$segment_pointer
*copyc clt$file
*copyc ost$date
*copyc ost$stack_frame_save_area
*copyc pme$analyze_program_dynamics
*copyc pmt$loader_seq_descriptor
*copyc pmt$condition_information
*copyc pmt$condition
?? POP ??
*copyc amp$get_segment_pointer
*copyc amp$return
*copyc amp$set_segment_eoi
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$set_status_abnormal
*copyc pmp$abort
*copyc pmp$get_unique_name
*copyc pmp$get_apd_task_jobmode_stats
*copyc pmp$meape_segments_constrained

?? NEWTITLE := '    PROCESS_BLOCK_EXITS' ??
?? EJECT ??

  PROCEDURE [XDCL] process_block_exits
    (    condition: pmt$condition;
         condition_descriptor: ^pmt$condition_information;
         save_area: ^ost$stack_frame_save_area;
     VAR status: ost$status);


    TYPE
      program_register = record
        filler: 0 .. 0ffff(16),
        instruction_opcode: ^0 .. 0ff(16),
      recend;

    CONST
      return_opcode = 04,
      pop_opcode = 06;

    VAR
      loader_seq_descriptor_ptr: ^pmt$loader_seq_descriptor,
      converter: record
        case 0 .. 1 of
        = 0 =
          stack_frame_save_area: ^ost$stack_frame_save_area,
        = 1 =
          p_register: ^program_register,
        casend,
      recend,
      current_job_statistics: pmt$apd_task_jobmode_statistics,
      final_job_statistics: pmt$apd_task_jobmode_statistics,
      interblock_reference_ptr: ^pmt$interblock_reference,
      interblock_references_hdr: ^pmt$interblock_references_hdr,
      interblock_reference_string: ^array [1 .. * ] of pmt$interblock_reference,
      opcode: 0 .. 0ff(16),
      p_register: program_register;


    loader_seq_descriptor_ptr := condition_descriptor;

    IF loader_seq_descriptor_ptr^.mpe_aborted THEN
      status.normal := TRUE;
      RETURN;
    ELSE
      pmp$get_apd_task_jobmode_stats (current_job_statistics);

      NEXT interblock_reference_ptr IN loader_seq_descriptor_ptr^.last_interblock_segment;
      IF interblock_reference_ptr = NIL THEN
        pmp$open_new_interblock_segment (loader_seq_descriptor_ptr^.seq_ptr);
        NEXT interblock_reference_ptr IN loader_seq_descriptor_ptr^.last_interblock_segment;
      IFEND;

      RESET loader_seq_descriptor_ptr^.last_interblock_segment;
      NEXT interblock_references_hdr IN loader_seq_descriptor_ptr^.last_interblock_segment;
      interblock_references_hdr^.number_of_interblock_references :=
            interblock_references_hdr^.number_of_interblock_references + 1;
      NEXT interblock_reference_string: [1 .. interblock_references_hdr^.number_of_interblock_references] IN
            loader_seq_descriptor_ptr^.last_interblock_segment;

      IF pmc$block_exit IN condition.reason THEN
        converter.stack_frame_save_area := save_area;
        p_register := converter.p_register^;
        opcode := p_register.instruction_opcode^;

        CASE opcode OF
        = return_opcode =
          interblock_reference_ptr^.reference_type := pmc$return;
          interblock_reference_ptr^.reference_time := current_job_statistics.jobmode_cptime -
                loader_seq_descriptor_ptr^.accumulated_intercept_time;
          interblock_reference_ptr^.page_fault_stats := current_job_statistics.paging_statistics;

        = pop_opcode =
          interblock_reference_ptr^.reference_type := pmc$pop;

        ELSE
          loader_seq_descriptor_ptr^.mpe_aborted := TRUE;
          osp$set_status_abnormal (pmc$program_management_id, pme$e_fatal_intercept_error, '', status);
          pmp$abort (status);
        CASEND;

      ELSE { pmc$program_termination or pmc$abort }

        interblock_reference_ptr^.reference_type := pmc$pop;
      IFEND;
      pmp$get_apd_task_jobmode_stats (final_job_statistics);

      loader_seq_descriptor_ptr^.accumulated_intercept_time :=
            loader_seq_descriptor_ptr^.accumulated_intercept_time +
            loader_seq_descriptor_ptr^.average_stats_request_time +
            (final_job_statistics.jobmode_cptime - current_job_statistics.jobmode_cptime);
    IFEND;

  PROCEND process_block_exits;
?? OLDTITLE ??
?? NEWTITLE := '    PROCESS_EXITS_FROM_APD' ??
?? EJECT ??

  PROCEDURE [XDCL] process_exit_from_apd
    (    condition: pmt$condition;
         condition_descriptor: ^pmt$condition_information;
         save_area: ^ost$stack_frame_save_area;
     VAR status: ost$status);

    VAR
      loader_seq_descriptor_ptr: ^pmt$loader_seq_descriptor;


    loader_seq_descriptor_ptr := condition_descriptor;

    IF loader_seq_descriptor_ptr^.mpe_aborted THEN
      RETURN;
    IFEND;

    pmp$add_final_interblock_ref (loader_seq_descriptor_ptr);

  PROCEND process_exit_from_apd;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] pmp$add_final_interblock_ref', EJECT ??

{ PURPOSE:
{   The purpose of this request is to record the final interblock reference
{   for an instumented APD task in the interblock references file when the
{   task has completed or aborted.
{
{ NOTES:
{   The loader and interblock references processing files for an APD task are
{   are not closed here since the task may still execute an end handler
{   before terminating.  An end handler causes task termination to call this
{   procedure to record its last interblock reference.  The processing files
{   are closed at task termination after all possible calls to this procedure
{   have been made.

  PROCEDURE [XDCL] pmp$add_final_interblock_ref
    (    loader_seq_descriptor_p: ^pmt$loader_seq_descriptor);

    VAR
      current_job_statistics: pmt$apd_task_jobmode_statistics,
      interblock_reference_ptr: ^pmt$interblock_reference,
      interblock_references_hdr: ^pmt$interblock_references_hdr,
      interblock_reference_string: ^array [1 .. * ] of pmt$interblock_reference;

    IF (loader_seq_descriptor_p = NIL) OR (loader_seq_descriptor_p^.mpe_aborted) THEN
      RETURN;
    IFEND;

    NEXT interblock_reference_ptr IN loader_seq_descriptor_p^.last_interblock_segment;
    IF interblock_reference_ptr = NIL THEN
      pmp$open_new_interblock_segment (loader_seq_descriptor_p^.seq_ptr);
      NEXT interblock_reference_ptr IN loader_seq_descriptor_p^.last_interblock_segment;
    IFEND;

    RESET loader_seq_descriptor_p^.last_interblock_segment;
    NEXT interblock_references_hdr IN loader_seq_descriptor_p^.last_interblock_segment;
    interblock_references_hdr^.number_of_interblock_references :=
          interblock_references_hdr^.number_of_interblock_references + 1;
    NEXT interblock_reference_string: [1 .. interblock_references_hdr^.number_of_interblock_references] IN
          loader_seq_descriptor_p^.last_interblock_segment;

    pmp$get_apd_task_jobmode_stats (current_job_statistics);

    interblock_reference_ptr^.reference_type := pmc$final_return;
    interblock_reference_ptr^.reference_time := current_job_statistics.jobmode_cptime -
          loader_seq_descriptor_p^.accumulated_intercept_time;
    interblock_reference_ptr^.page_fault_stats := current_job_statistics.paging_statistics;

  PROCEND pmp$add_final_interblock_ref;
?? OLDTITLE ??
?? NEWTITLE := '  PMP$OPEN_NEW_INTERBLOCK_SEGMENT' ??
?? EJECT ??

  PROCEDURE [XDCL] pmp$open_new_interblock_segment
    (VAR loader_seq_descriptor_ptr: ^SEQ ( * ));

    VAR
      constrained: boolean,
      file_attachment: ^fst$attachment_options,
      file_id: amt$file_identifier,
      file_name: ost$name,
      ignore_status: ost$status,
      interblock_reference_string: ^array [1 .. * ] of pmt$interblock_reference,
      interblock_references_hdr: ^pmt$interblock_references_hdr,
      loader_seq_descriptor: ^pmt$loader_seq_descriptor,
      loader_seq_descriptor_ptr_copy: ^SEQ ( * ),
      mandated_creation_attributes: ^fst$file_cycle_attributes,
      old_segment_pointer: amt$segment_pointer,
      segment_pointer: amt$segment_pointer,
      status: ost$status;

    pmp$meape_segments_constrained (constrained);
    IF constrained THEN
      RETURN;
    IFEND;

    pmp$get_unique_name (file_name, status);
    IF NOT status.normal THEN
      pmp$abort (status);
    IFEND;

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

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

    fsp$open_file (file_name, amc$segment, file_attachment, NIL, mandated_creation_attributes, NIL, NIL,
          file_id, status);
    IF NOT status.normal THEN
      amp$return (file_name, ignore_status);
      pmp$abort (status);
    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 (file_name, ignore_status);
      pmp$abort (status);
    IFEND;

    loader_seq_descriptor_ptr_copy := loader_seq_descriptor_ptr;
    RESET loader_seq_descriptor_ptr_copy;
    NEXT loader_seq_descriptor IN loader_seq_descriptor_ptr_copy;
    IF loader_seq_descriptor = NIL THEN
      osp$set_status_abnormal (pmc$program_management_id, pme$e_internal_mpe_seg_overflow, '', status);
      fsp$close_file (file_id, ignore_status);
      amp$return (file_name, ignore_status);
      pmp$abort (status);
    IFEND;

    RESET loader_seq_descriptor^.last_interblock_segment;
    NEXT interblock_references_hdr IN loader_seq_descriptor^.last_interblock_segment;
    IF interblock_references_hdr = NIL THEN
      loader_seq_descriptor^.mpe_aborted := TRUE;
      osp$set_status_abnormal (pmc$program_management_id, pme$e_internal_mpe_seg_overflow, '', status);
      fsp$close_file (file_id, ignore_status);
      amp$return (file_name, ignore_status);
      pmp$abort (status);
    IFEND;
    interblock_references_hdr^.next_segment_file_name := file_name;

    NEXT interblock_reference_string: [1 .. interblock_references_hdr^.number_of_interblock_references] IN
          loader_seq_descriptor^.last_interblock_segment;
    IF interblock_reference_string = NIL THEN
      loader_seq_descriptor^.mpe_aborted := TRUE;
      osp$set_status_abnormal (pmc$program_management_id, pme$e_internal_mpe_seg_overflow, '', status);
      interblock_references_hdr^.next_segment_file_name := osc$null_name;
      fsp$close_file (file_id, ignore_status);
      amp$return (file_name, ignore_status);
      pmp$abort (status);
    IFEND;

    old_segment_pointer.kind := amc$sequence_pointer;
    old_segment_pointer.sequence_pointer := loader_seq_descriptor^.last_interblock_segment;
    amp$set_segment_eoi (interblock_references_hdr^.file_id, old_segment_pointer, status);
    fsp$close_file (interblock_references_hdr^.file_id, status);

    loader_seq_descriptor^.last_interblock_segment := segment_pointer.sequence_pointer;
    loader_seq_descriptor^.number_of_interblock_segments :=
          loader_seq_descriptor^.number_of_interblock_segments + 1;
    RESET loader_seq_descriptor^.last_interblock_segment;
    NEXT interblock_references_hdr IN loader_seq_descriptor^.last_interblock_segment;
    IF interblock_references_hdr = NIL THEN
      loader_seq_descriptor^.mpe_aborted := TRUE;
      osp$set_status_abnormal (pmc$program_management_id, pme$e_internal_mpe_seg_overflow, '', status);
      fsp$close_file (file_id, ignore_status);
      pmp$abort (status);
    IFEND;

    interblock_references_hdr^.file_id := file_id;
    interblock_references_hdr^.number_of_interblock_references := 0;
    interblock_references_hdr^.next_segment_file_name := osc$null_name;

  PROCEND pmp$open_new_interblock_segment;
?? OLDTITLE ??
MODEND pmm$mpe_record_call_and_return;
