?? RIGHT := 110 ??
MODULE osm$monitor_keypoint_support;
?? TITLE := 'Monitor Mode Keypoint Support ' ??
?? PUSH (LISTEXT := ON) ??
*copyc dmt$error_condition_codes
*copyc gft$locked_file_desc_entry_p
*copyc ioe$st_errors
*copyc mmt$keypoint_page_fault_status
*copyc mtc$job_fixed_segment
*copyc osc$purge_map_and_cache
*copyc osd$default_pragmats
*copyc ose$keypoint_conditions
*copyc ost$processor_id
*copyc ost$stack_frame_save_area
*copyc tmv$ptl_lock
*copyc tmv$ptl_p
*copyc tmv$new_ptl_lock

{ Common decks for global variables referenced by this module.

*copyc jmv$ijl_p
*copyc jmv$null_ijl_ordinal
*copyc jmv$system_ijl_ordinal
*copyc mmv$ast_p
*copyc mmv$multiple_page_maps
*copyc mmv$pt_p
*copyc mmv$pft_p
*copyc mmv$reassignable_page_frames
*copyc mmv$time_to_call_mem_mgr
*copyc mtv$cst0
*copyc mtv$monitor_segment_table
*copyc mtv$scb
*copyc osv$mainframe_wired_cb_heap
*copyc osv$page_size
*copyc osv$ppu_keypoint_control
*copyc osv$time_to_check_asyn
*copyc syv$perf_keypoints_enabled
*copyc syv$pmf_cb_rm_word_address

{Common decks for procedures referenced by this module.

*copyc gfp$mtr_get_locked_fde_p
*copyc i#mtr_disable_traps
*copyc i#move
*copyc i#mtr_restore_traps
*copyc iop$pager_io
*copyc jmp$get_ijle_p
*copyc jmp$unlock_ajl
*copyc mmp$assign_page_to_monitor
*copyc mmp$asti
*copyc mmp$convert_pva
*copyc mmp$delete_page_from_monitor
*copyc mmp$dump_shared_queue
*copyc mmp$get_avail_page_frame
*copyc mmp$link_page_to_segment
*copyc mmp$relink_page_frame
*copyc mmp$unlink_page_from_segment
*copyc mtp$cst_p
*copyc mtp$error_stop
*copyc osp$fetch_locked_variable
*copyc osp$set_locked_variable
*copyc tmp$cause_task_switch
*copyc tmp$new_clear_lock
*copyc tmp$new_set_lock
*copyc tmp$clear_lock
*copyc tmp$find_next_xcb
*copyc tmp$get_xcb_access_status
*copyc tmp$get_xcb_p
*copyc tmp$reissue_monitor_request
*copyc tmp$set_lock
*copyc tmp$set_system_flag
*copyc sft$file_space_limit_kind
*copyc ost$keypoint_control
*copyc ost$keypoint_environment
?? POP ??

  VAR
    cl15_enabled: boolean := TRUE,
    dummy_align: integer,

{ The following two variables MUST be kept together. The dummy alignment variable
{ resolves an alignment problem.

    dummy_alignment_variable: [XDCL] integer := 0,
    keypoint_lock: tmt$new_ptl_lock := [FALSE, 0],
    keypoint_stats: record
      in_count,
      out_count,
      mtr_pf,
      mtr_pf_skip,
      periodic: integer,
    recend := [0, 0, 0, 0, 0],
    null_sva: ost$system_virtual_address := [0, 0],
    osv$keypoint_control: [XDCL, #GATE] ost$keypoint_control := [FALSE, FALSE,
      $ost$keypoint_mask [], $ost$keypoint_mask [], $ost$keypoint_mask [],
      $ost$keypoint_mask [], * , * , 0, 0, 0, * , [0, 0], - 2, - 1, 0, 0,
      [REP osc$max_number_of_processors of *], [REP osc$max_number_of_processors of NIL],
      $ost$processor_id_set [ ], FALSE,
      [REP 8 of [0, * , 0, * , 0, * , NIL, * , 0, FALSE, 999]]],
    osv$keypoint_enable: [XDCL, #GATE] integer := osc$kpt_normal,
    osv$max_kpt_pages: [XDCL, #GATE] integer := osc$max_kpt_pages,
    termination_in_progress: [STATIC] boolean := FALSE;

?? NEWTITLE := 'osp$setup_keypoint_pages', EJECT ??

  PROCEDURE osp$setup_keypoint_pages
    (VAR status: syt$monitor_status);

    VAR
      astep: ^mmt$active_segment_table_entry,
      cstp: ^ost$cpu_state_table,
      fde_entry_p: gft$locked_file_desc_entry_p,
      found: boolean,
      hc: integer,
      i: integer,
      incr: integer,
      ipti: integer,
      lpid: integer,
      offset: integer,
      pfti: integer,
      pkc: ^ost$processor_keypoint_control,
      pr: ost$read_register,
      pva: ^cell,
      sva: ost$system_virtual_address,
      step: ^mmt$segment_descriptor,
      stxep: ^mmt$segment_descriptor_extended,
      tstatus: syt$monitor_status;

    lpid := #read_register (osc$pr_processor_id);
    pkc := ^osv$keypoint_control.cpus [lpid];

    status.normal := TRUE;
    tmp$new_set_lock (keypoint_lock);
    IF pkc^.active THEN
      tmp$new_clear_lock (keypoint_lock);
      RETURN;
    IFEND;
    termination_in_progress := FALSE;
    pva := pkc^.collector_pva;
    IF osv$keypoint_enable = osc$kpt_test_mode THEN
      { force all keypoints to cause page faults - mtr checkout only
      pr.pva := pva;
      pr.fill := 0;
      #write_register (osc$pr_keypoint_buffer_ptr, pr.i);
      pkc^.active := TRUE;
      tmp$new_clear_lock (keypoint_lock);
      RETURN;
    IFEND;
    mmp$assign_page_to_monitor (pva, osv$keypoint_control.max_pages, TRUE, status);
    incr := osv$keypoint_control.max_pages * osv$page_size;
    offset := #offset (pva);
    WHILE NOT status.normal DO
      offset := offset + incr;

{ each processor can use a range of osc$kpt_pva_increment bytes but must not go
{ closer to the next
{ (processor's) range than 1 page so that a page fault will always be generated
{ at the end of each range (i.e. dont let one range spill over into the next

      IF (offset + incr) > (osc$kpt_pva_increment - osv$page_size) THEN
        { exceeded pva range for a processor - cant get pages
        tmp$new_clear_lock (keypoint_lock);
        RETURN;
      IFEND;
      pva := #address (1, #segment (pva), #offset (pva) + incr);
      mmp$assign_page_to_monitor (pva, osv$keypoint_control.max_pages, TRUE, status);
    WHILEND;
    pkc^.collector_pva := pva;

{ find pfti and pti of initial pages

    mtp$cst_p (cstp);
    mmp$convert_pva (pva, cstp, sva, fde_entry_p, astep, step, stxep);
    FOR i := 1 TO osv$keypoint_control.max_pages DO
      #hash_sva (sva, ipti, hc, found);
      IF NOT found THEN
        mtp$error_stop ('KP - setup #hash');
      IFEND;
      pfti := mmv$pt_p^ [ipti].rma DIV (osv$page_size DIV 512);
      pkc^.in_use_pfti [i] := pfti;
      sva.offset := sva.offset + osv$page_size;
    FOREND;
    pkc^.in_use_count := osv$keypoint_control.max_pages;
    keypoint_stats.in_count := keypoint_stats.in_count +
          osv$keypoint_control.max_pages;

    fill_avail (pkc, status);
    IF NOT status.normal THEN
      mmp$delete_page_from_monitor (pva, osv$keypoint_control.max_pages,
            tstatus);
      keypoint_stats.in_count := keypoint_stats.in_count -
            osv$keypoint_control.max_pages;
      RETURN;
    IFEND;
    pkc^.active := TRUE;
    pr.pva := pva;
    pr.fill := 0;
    #write_register (osc$pr_keypoint_buffer_ptr, pr.i);
    IF (osv$keypoint_control.environment = osc$job_keypoints) OR
        (osv$keypoint_control.environment = osc$job_sample_keypoints) THEN
      cstp^.xcb_p^.keypoint_enable := TRUE;
    IFEND;
    tmp$new_clear_lock (keypoint_lock);
  PROCEND osp$setup_keypoint_pages;
?? TITLE := 'fill_avail', EJECT ??

  PROCEDURE fill_avail
    (pkc: ^ost$processor_keypoint_control;
     VAR status: syt$monitor_status);

    VAR
      i: integer,
      j: integer,
      pfti: mmt$page_frame_index;

    IF pkc^.avail_count <> 0 THEN
      mtp$error_stop ('KP - avail not zero');
    IFEND;

    IF termination_in_progress THEN
      status.normal := FALSE;
      status.condition := ose$kpt_coll_term_mbs_error;
      RETURN;
    IFEND;

    IF mmv$reassignable_page_frames.now < osv$keypoint_control.max_pages THEN
      mmp$dump_shared_queue (osv$keypoint_control.max_pages);
    IFEND;

  /get_avail_pages/
    FOR i := 1 TO osv$keypoint_control.max_pages DO
      mmp$get_avail_page_frame (pfti);
      IF pfti = 0 THEN

{ pages not available - return

        FOR j := 1 TO (i - 1) DO
          mmp$relink_page_frame (pkc^.avail_pfti [j], mmc$pq_free);
        FOREND;
        pkc^.avail_count := 0;
        status.normal := FALSE;
        status.condition := ose$kpt_coll_term_mbs_error;
        RETURN;
      IFEND;
      mmp$relink_page_frame (pfti, mmc$pq_wired);
      mmv$pft_p^ [pfti].sva := null_sva;
      pkc^.avail_count := pkc^.avail_count + 1;
      pkc^.avail_pfti [i] := pfti;
    FOREND /get_avail_pages/;
    keypoint_stats.in_count := keypoint_stats.in_count +
          osv$keypoint_control.max_pages;
    status.normal := TRUE;
  PROCEND fill_avail;
?? TITLE := 'osp$process_keypoint_page_fault', EJECT ??

  PROCEDURE [XDCL] osp$process_keypoint_page_fault
    (    utp_offset: integer;
     VAR keypoint_page_fault_status: mmt$keypoint_page_fault_status);

    VAR
      cstp: ^ost$cpu_state_table,
      i,
      j: integer,
      lpid: integer,
      pkc: ^ost$processor_keypoint_control,
      pr: ost$read_register,
      pva: ost$pva,
      trick: ost$read_register,
      utp: ^cell;

    lpid := #read_register (osc$pr_processor_id);
    pkc := ^osv$keypoint_control.cpus [lpid];

    trick.i := #read_register (osc$pr_keypoint_buffer_ptr);
    i := #offset (trick.pva);

    keypoint_page_fault_status := mmc$kpfs_normal;

    IF  (utp_offset <> (#offset (pkc^.collector_pva) +
          (osv$keypoint_control.max_pages * osv$page_size))) THEN
      keypoint_page_fault_status := mmc$kpfs_invalid_keypoint;
      RETURN;
    ELSEIF (NOT osv$keypoint_control.active) AND (osv$keypoint_control.ijlo <> jmv$null_ijl_ordinal) THEN
      mtp$cst_p (cstp);
      IF cstp^.xcb_p <> NIL THEN
        cstp^.xcb_p^.keypoint_register_enable := FALSE;
      IFEND;
      keypoint_page_fault_status := mmc$kpfs_disable_keypoints;
      RETURN;
    ELSEIF (i <> (#offset (pkc^.collector_pva) + (osv$keypoint_control.max_pages * osv$page_size))) THEN

{ This condition handles the case of a job mode page fault. The job mode page fault processing causes
{ a monitor page fault. The monitor page fault is satisfied first, and satisfies the job mode fault.
{ However, the job mode page fault will still be processed, and therefore we simply return in this case.

      RETURN;
    IFEND;

    IF osv$keypoint_control.termination_status <> osc$kp_term_not_stopped THEN
      keypoint_page_fault_status := mmc$kpfs_disable_keypoints;
      RETURN;
    IFEND;

    IF osv$keypoint_enable = osc$kpt_test_mode THEN
      mtp$cst_p (cstp);
      cstp^.xcb_p^.xp.p_register.pva.offset := cstp^.xcb_p^.xp.p_register.pva.
            offset + 4;
      RETURN;
    IFEND;

    pr.i := #read_register (osc$pr_keypoint_buffer_ptr);

    IF (#offset (pr.pva) - #offset (pkc^.collector_pva)) <> (osv$page_size *
          osv$keypoint_control.max_pages) THEN
      { assume kbp (etc) has already been reset
      { e.g. job mode pf, mtr pf trap, process mtr pf, process job mode pf.
      RETURN;
    IFEND;

    tmp$new_set_lock (keypoint_lock);

{ process trace keypoints specially

    IF (osv$keypoint_control.environment = osc$system_sample_keypoints) OR
          (osv$keypoint_control.environment = osc$job_sample_keypoints) THEN
      pr.pva := pkc^.collector_pva;
      pr.fill := 0;
      #write_register (osc$pr_keypoint_buffer_ptr, pr.i);
      pkc^.offset := pkc^.offset + (osv$page_size * osv$keypoint_control.
            max_pages);
      IF (pkc^.offset DIV 8) >= osv$keypoint_control.maximum_keypoints THEN
        terminate_keypoint_collection (ose$kpt_coll_term_max_kpts);
        keypoint_page_fault_status := mmc$kpfs_disable_keypoints;
      IFEND;
      tmp$new_clear_lock (keypoint_lock);
      RETURN;
    IFEND;

{ move in_use to io

    IF pkc^.io_count <> 0 THEN
      { i/o has fallen behind collection - stop collection
      terminate_keypoint_collection (ose$kpt_coll_term_mbs_error);
      keypoint_page_fault_status := mmc$kpfs_disable_keypoints;
      tmp$new_clear_lock (keypoint_lock);
      RETURN;
    IFEND;
    FOR i := 1 TO pkc^.in_use_count DO
      pkc^.io_pfti [i] := pkc^.in_use_pfti [i];
    FOREND;
    pkc^.io_count := pkc^.in_use_count;
    pkc^.in_use_count := 0;

{ check for keypoint collection done

    IF (pkc^.offset + (pkc^.io_count * osv$page_size)) DIV 8 >=
          osv$keypoint_control.maximum_keypoints THEN

{ terminating--need to unlink the io (=in_use) pages from the segment

      FOR i := 1 TO pkc^.io_count DO
        mmp$unlink_page_from_segment (^mmv$pft_p^ [pkc^.io_pfti [i]], mmv$pft_p^ [pkc^.
              io_pfti [i]].aste_p);
      FOREND;
      terminate_keypoint_collection (ose$kpt_coll_term_max_kpts);
      keypoint_page_fault_status := mmc$kpfs_disable_keypoints;
    ELSE

{ move avail to in use

      IF pkc^.avail_count > 0 THEN
        FOR i := 1 TO pkc^.avail_count DO
          pkc^.in_use_pfti [i] := pkc^.avail_pfti [i];

{ Unlink the old (io) page frame from the segemnt, copy fields from the old (io) pft to
{ the new (in_use) pft as required, and link the new (in_use) page frame to the segment.

          mmp$unlink_page_from_segment (^mmv$pft_p^ [pkc^.io_pfti [i]], mmv$pft_p^ [pkc^.
                io_pfti [i]].aste_p);
          mmv$pft_p^ [pkc^.in_use_pfti [i]].ijl_ordinal := mmv$pft_p^ [pkc^.
                io_pfti [i]].ijl_ordinal;
          mmv$pft_p^ [pkc^.in_use_pfti [i]].age := mmv$pft_p^ [pkc^.io_pfti
                [i]].age;
          mmv$pft_p^ [pkc^.in_use_pfti [i]].aste_p := mmv$pft_p^ [pkc^.io_pfti
                [i]].aste_p;
          mmv$pft_p^ [pkc^.in_use_pfti [i]].sva := mmv$pft_p^ [pkc^.io_pfti
                [i]].sva;
          mmv$pft_p^ [pkc^.in_use_pfti [i]].pti := mmv$pft_p^ [pkc^.io_pfti
                [i]].pti;
          mmp$link_page_to_segment (pkc^.in_use_pfti [i], ^mmv$pft_p^ [pkc^.in_use_pfti [i]],
                mmv$pft_p^ [pkc^.in_use_pfti [i]].aste_p);

{ change the page table rma

          mmv$pt_p^ [mmv$pft_p^ [pkc^.in_use_pfti [i]].pti].rma := (pkc^.
                in_use_pfti [i] * osv$page_size) DIV 512;
        FOREND;
        #purge_buffer (osc$pva_purge_all_page_seg_map, pkc^.collector_pva);
        pkc^.in_use_count := pkc^.avail_count;
        pkc^.avail_count := 0;
      ELSE

{ terminating--need to unlink the io (=in_use) pages from the segment

        FOR i := 1 TO pkc^.io_count DO
          mmp$unlink_page_from_segment (^mmv$pft_p^ [pkc^.io_pfti [i]], mmv$pft_p^ [pkc^.
                io_pfti [i]].aste_p);
        FOREND;
        terminate_keypoint_collection (ose$kpt_coll_term_mbs_error);
        keypoint_page_fault_status := mmc$kpfs_disable_keypoints;
      IFEND;
    IFEND;
    osv$keypoint_control.periodic_requested := TRUE;
    mmv$time_to_call_mem_mgr := 0;
    mtp$cst_p (cstp);
    cstp^.dispatch_control.asynchronous_interrupts_pending := TRUE;
    osv$time_to_check_asyn := 0;
    { reset KBP
    pr.pva := pkc^.collector_pva;
    pr.fill := 0;
    #write_register (osc$pr_keypoint_buffer_ptr, pr.i);

    tmp$new_clear_lock (keypoint_lock);
  PROCEND osp$process_keypoint_page_fault;
?? TITLE := 'osp$process_keypoint_periodic', EJECT ??

  PROCEDURE [XDCL] osp$process_keypoint_periodic;

    CONST
      allow_allocation = TRUE;

    VAR
      bd: mmt$buffer_descriptor,
      chapter_offset: integer,
      fde_entry_p: gft$locked_file_desc_entry_p,
      ijle_p: ^jmt$initiated_job_list_entry,
      io_id: mmt$io_identifier,
      j: integer,
      lpid: integer,
      max_pages_per_io: integer,
      offset: integer,
      osv$keypoint_periodic_lpid: [XDCL] integer := 9999,
      pkc: ^ost$processor_keypoint_control,
      ppio: integer,
      status: syt$monitor_status;

    tmp$new_set_lock (keypoint_lock);
    io_id.specified := FALSE;
    io_id.io_function := ioc$keypoint_io;
    keypoint_stats.periodic := keypoint_stats.periodic + 1;
    osv$keypoint_control.periodic_requested := FALSE;

    IF (osv$keypoint_control.environment = osc$system_keypoints) OR
          (osv$keypoint_control.environment = osc$job_keypoints) THEN

    /write_to_disk/
      FOR lpid := osv$keypoint_control.first_active_processor TO
            osv$keypoint_control.last_active_processor DO
        pkc := ^osv$keypoint_control.cpus [lpid];
        IF pkc^.avail_count = 0 THEN
          fill_avail (pkc, status);
          { ignore status - stop only on page fault
        IFEND;
        offset := #offset (pkc^.collector_pva);
        jmp$get_ijle_p (osv$keypoint_control.ijlo, ijle_p);
        gfp$mtr_get_locked_fde_p (pkc^.sfid, ijle_p, fde_entry_p);
        max_pages_per_io := fde_entry_p^.allocation_unit_size DIV osv$page_size;
        WHILE pkc^.io_count > 0 DO
          IF pkc^.io_count > max_pages_per_io THEN
            ppio := max_pages_per_io;
          ELSE
            ppio := pkc^.io_count;
          IFEND;

          bd.buffer_descriptor_type := mmc$bd_paging_io;
          bd.sva.offset := offset;
          bd.sva.asid := mmv$pt_p^ [mmv$pft_p^ [pkc^.io_pfti [1]].pti].pageid.
                asid;
          bd.page_count := ppio;
          osv$keypoint_periodic_lpid := lpid;
          iop$pager_io (fde_entry_p, pkc^.offset, bd,
                ppio * osv$page_size, ioc$keypoint_io, io_id, status);
          IF NOT status.normal THEN
            IF (status.condition = dme$transient_error) OR
               (status.condition = ioe$requests_full) THEN
              osv$keypoint_control.periodic_requested := TRUE;
              CYCLE /write_to_disk/;
            ELSE
              terminate_keypoint_collection (status.condition);
            IFEND;
          IFEND;
          IF pkc^.io_count > ppio THEN
            { shift io pfti's to the start of the list for the next iteration
            FOR j := (ppio + 1) TO pkc^.io_count DO
              pkc^.io_pfti [j - ppio] := pkc^.io_pfti [j];
            FOREND;
          IFEND;
          pkc^.offset := pkc^.offset + (ppio * osv$page_size);
          offset := offset + (ppio * osv$page_size);
          keypoint_stats.out_count := keypoint_stats.out_count + pkc^.
                io_count;
          pkc^.io_count := pkc^.io_count - ppio;
        WHILEND;
      FOREND /write_to_disk/;
    IFEND;

    osv$keypoint_periodic_lpid := 9999;
    tmp$new_clear_lock (keypoint_lock);
  PROCEND osp$process_keypoint_periodic;
?? TITLE := 'terminate_keypoint_collection', EJECT ??

  PROCEDURE terminate_keypoint_collection
    (reason: integer);

    VAR
      cst_p: ^ost$cpu_state_table;

{ stop keypoint collection -
{    stop IMMEDIATELY for this processor in MTR mode

    tmp$new_set_lock (keypoint_lock);
    osv$keypoint_control.jm := $ost$keypoint_mask [];
    osv$keypoint_control.mm := $ost$keypoint_mask [];
    osv$keypoint_control.termination_status := reason;
    osv$keypoint_control.active := FALSE;
    tmp$new_clear_lock (keypoint_lock);
    #write_register (osc$pr_clear_keypoint_enable,
          osc$pr_clear_keypoint_enable);
    mtp$cst_p (cst_p);
    IF cst_p^.xcb_p <> NIL THEN
      cst_p^.xcb_p^.keypoint_register_enable := FALSE;
    IFEND;

  PROCEND terminate_keypoint_collection;
?? TITLE := 'propagate_keypoint_masks', EJECT ??

  PROCEDURE propagate_keypoint_masks
    (VAR status: syt$monitor_status);

    VAR
      cstp: ^ost$cpu_state_table,
      kef: boolean,
      lmm: ^0 .. 0ffff(16),
      mm: ost$keypoint_mask;

    status.normal := TRUE;
    mtp$cst_p (cstp);
    IF (osv$keypoint_control.environment = osc$system_keypoints) OR
          (osv$keypoint_control.environment = osc$system_sample_keypoints) OR
          (osv$keypoint_control.ijlo = cstp^.ijl_ordinal) THEN
      mm := osv$keypoint_control.mm;
    ELSE
      mm := $ost$keypoint_mask [];
    IFEND;

    lmm := #LOC (mm);
    #write_register (osc$pr_keypoint_mask, lmm^);
    kef := (mm <> $ost$keypoint_mask []) OR (osv$keypoint_control.jm <> $ost$keypoint_mask []);
    IF kef THEN
      #write_register (osc$pr_set_keypoint_enable, osc$pr_set_keypoint_enable);
    ELSE
      #write_register (osc$pr_clear_keypoint_enable,
            osc$pr_clear_keypoint_enable);
    IFEND;
    change_tasks_keypoint_masks (kef, cstp, status);

  PROCEND propagate_keypoint_masks;
?? TITLE := 'change_tasks_keypoint_masks', EJECT ??

  PROCEDURE change_tasks_keypoint_masks
    (    keypoint_enabled_flag: boolean;
         cst_p: ^ost$cpu_state_table;
     VAR status: syt$monitor_status);

    VAR
      inhibit_access: boolean,
      ijle_p: ^jmt$initiated_job_list_entry,
      j: integer,
      max_ptlo: ost$task_index,
      ptlo: ost$task_index,
      swapped: boolean,
      xcbp: ^ost$execution_control_block,
      xcb_state: tmt$find_next_xcb_state;


    status.normal := TRUE;
    IF (osv$keypoint_control.environment = osc$system_keypoints) OR
          (osv$keypoint_control.environment = osc$system_sample_keypoints) THEN
      tmp$set_lock (tmv$ptl_lock{, mtc$ignore});
      max_ptlo := UPPERBOUND (tmv$ptl_p^);
      FOR ptlo := 1 TO max_ptlo DO
        IF tmv$ptl_p^ [ptlo].status <> tmc$ts_null THEN
          jmp$get_ijle_p (tmv$ptl_p^ [ptlo].ijl_ordinal, ijle_p);
          IF (tmv$ptl_p^ [ptlo].status = tmc$ts_executing) AND (ptlo <> cst_p^.taskid.index) THEN
            xcbp := #ADDRESS (1, ijle_p^.ajl_ordinal + mtc$job_fixed_segment, tmv$ptl_p^ [ptlo].xcb_offset);
            IF (keypoint_enabled_flag AND (NOT xcbp^.keypoint_register_enable)) OR
              (NOT keypoint_enabled_flag AND (xcbp^.keypoint_register_enable)) THEN
              status.normal := FALSE;
              status.condition := ose$fail_to_update_keyp_flags;
            IFEND;
          ELSE
            tmp$get_xcb_access_status (ijle_p, tmv$ptl_p^ [ptlo].ijl_ordinal, inhibit_access);
            IF inhibit_access THEN
              ijle_p^.delayed_swapin_work := ijle_p^.delayed_swapin_work +
                  $jmt$delayed_swapin_work [jmc$dsw_update_keypoint_masks];
            ELSE
              xcbp := #ADDRESS (1, ijle_p^.ajl_ordinal + mtc$job_fixed_segment, tmv$ptl_p^ [ptlo].xcb_offset);
              IF keypoint_enabled_flag THEN
                xcbp^.xp.flags := xcbp^.xp.flags + $ost$flags [osc$keypoint_enable];
                xcbp^.keypoint_register_enable := TRUE;
              ELSE
                xcbp^.xp.flags := xcbp^.xp.flags - $ost$flags [osc$keypoint_enable];
                xcbp^.keypoint_register_enable := FALSE;
              IFEND;
              xcbp^.xp.keypoint_mask := osv$keypoint_control.jm;
              jmp$unlock_ajl (ijle_p);
            IFEND;
          IFEND;
        IFEND;
      FOREND;
      tmp$clear_lock (tmv$ptl_lock);
    ELSEIF (osv$keypoint_control.environment = osc$job_keypoints) OR
        (osv$keypoint_control.environment = osc$job_sample_keypoints) THEN
      jmp$get_ijle_p (osv$keypoint_control.ijlo, ijle_p);
      tmp$find_next_xcb (tmc$fnx_job, ijle_p, osv$keypoint_control.ijlo, xcb_state, xcbp);
      WHILE xcbp <> NIL DO
        IF xcbp^.keypoint_enable THEN
          IF keypoint_enabled_flag THEN
            xcbp^.xp.flags := xcbp^.xp.flags + $ost$flags [osc$keypoint_enable];
            xcbp^.keypoint_register_enable := TRUE;
          ELSE
            xcbp^.xp.flags := xcbp^.xp.flags - $ost$flags [osc$keypoint_enable];
            xcbp^.keypoint_register_enable := FALSE;
          IFEND;
          xcbp^.xp.keypoint_mask := osv$keypoint_control.jm;
        IFEND;
        tmp$find_next_xcb (tmc$fnx_continue, NIL, osv$keypoint_control.ijlo, xcb_state, xcbp);
      WHILEND;
    IFEND;

  PROCEND change_tasks_keypoint_masks;
?? TITLE := 'osp$update_job_keypoint_mask', EJECT ??

  PROCEDURE [XDCL] osp$update_job_keypoint_mask
    (ijle_p: ^jmt$initiated_job_list_entry;
     ijl_ordinal: jmt$ijl_ordinal);

{ This procedure is called by the job swapper at swapin time if
{ jmc$dsw_update_keypoint_masks was set in the ijl delayed_swapin_work
{ field for the job being swapped in.

    VAR
      jm: ost$keypoint_mask,
      kef: boolean,
      xcbp: ^ost$execution_control_block,
      xcb_state: tmt$find_next_xcb_state;

    tmp$new_set_lock (keypoint_lock);
    IF osv$keypoint_control.active THEN
      IF (osv$keypoint_control.environment = osc$system_keypoints) OR
            (osv$keypoint_control.environment = osc$system_sample_keypoints)
            THEN
        jm := osv$keypoint_control.jm;
      ELSE
{ check if correct job
        IF osv$keypoint_control.ijlo = ijl_ordinal THEN
{ correct - update masks
          jm := osv$keypoint_control.jm;
        ELSE
{ different - clear masks
          jm := $ost$keypoint_mask [];
        IFEND;
      IFEND;
    ELSE
      jm := $ost$keypoint_mask [];
    IFEND;
    kef := jm <> $ost$keypoint_mask [];
    tmp$find_next_xcb (tmc$fnx_job, ijle_p, ijl_ordinal, xcb_state, xcbp);
    WHILE xcbp <> NIL DO
      IF kef THEN
        xcbp^.xp.flags := xcbp^.xp.flags + $ost$flags [osc$keypoint_enable];
        xcbp^.keypoint_register_enable := TRUE;
      ELSE
        xcbp^.xp.flags := xcbp^.xp.flags - $ost$flags [osc$keypoint_enable];
        xcbp^.keypoint_register_enable := FALSE;
      IFEND;
      xcbp^.xp.keypoint_mask := jm;
      tmp$find_next_xcb (tmc$fnx_continue, NIL, jmv$null_ijl_ordinal, xcb_state, xcbp);
    WHILEND;
    tmp$new_clear_lock (keypoint_lock);
  PROCEND osp$update_job_keypoint_mask;
?? TITLE := 'osp$process_job_keypoint_req', EJECT ??

  PROCEDURE [XDCL] osp$process_job_keypoint_req
    (VAR rb:ost$rb_keypoint_request);

    VAR
      cst_p: ^ost$cpu_state_table,
      lpid: integer,
      pr: ost$read_register,
      status: syt$monitor_status;

    mtp$cst_p (cst_p);
    rb.status.normal := TRUE;
    lpid := #READ_REGISTER (osc$pr_processor_id);
    CASE rb.sub_request OF
    = osc$kpt_mr_init =
      osp$setup_keypoint_pages (rb.status);
      IF rb.status.normal THEN
        put_stuff_in_buffer (lpid, rb);
      IFEND;
    = osc$kpt_mr_start =
      IF (osv$keypoint_control.environment = osc$job_keypoints) OR
          (osv$keypoint_control.environment = osc$job_sample_keypoints) THEN
        IF NOT cst_p^.xcb_p^.keypoint_enable THEN
          rb.status.normal := FALSE;
          rb.status.condition := ose$kpt_illegal_request;
          RETURN;
        IFEND;
      IFEND;
      IF termination_in_progress THEN
        rb.status.normal := FALSE;
        rb.status.condition := ose$kpt_illegal_request;
        RETURN;
      IFEND;
      IF osv$keypoint_control.termination_status = osc$kp_term_not_stopped THEN
        put_stuff_in_buffer (lpid, rb);
      ELSE
        rb.status.normal := FALSE;
        rb.status.condition := osv$keypoint_control.termination_status;
      IFEND;
    = osc$kpt_mr_stop =
      IF (osv$keypoint_control.environment = osc$job_keypoints) OR
          (osv$keypoint_control.environment = osc$job_sample_keypoints) THEN
        IF NOT cst_p^.xcb_p^.keypoint_enable THEN
          rb.status.normal := FALSE;
          rb.status.condition := ose$kpt_illegal_request;
          RETURN;
        IFEND;
      IFEND;
      IF termination_in_progress THEN
        rb.status.normal := FALSE;
        rb.status.condition := ose$kpt_illegal_request;
        RETURN;
      IFEND;
      osv$keypoint_control.jm := $ost$keypoint_mask [];
      osv$keypoint_control.mm := $ost$keypoint_mask [];
      osv$keypoint_control.active := FALSE;

{ The STOP request will propagate masks to as many tasks as possible. This request is not concerned
{ with bad status being returned from the propagate_keypoint_masks procedure. Any
{ tasks which have not had the keypoint masks modified, will have them modified the
{ next time they page fault.

      propagate_keypoint_masks (status);
      put_stuff_in_buffer (lpid, rb);
    = osc$kpt_mr_issue =
      IF (osv$keypoint_control.environment = osc$job_keypoints) OR
          (osv$keypoint_control.environment = osc$job_sample_keypoints) THEN
        IF NOT cst_p^.xcb_p^.keypoint_enable THEN
          rb.status.normal := FALSE;
          rb.status.condition := ose$kpt_illegal_request;
          RETURN;
        IFEND;
      IFEND;
      IF termination_in_progress THEN
        rb.status.normal := FALSE;
        rb.status.condition := ose$kpt_illegal_request;
        RETURN;
      IFEND;
      put_stuff_in_buffer (lpid, rb);
    = osc$kpt_mr_term =

{ The additional clause is required in this statement because this code is
{ executed for each processor. The other job mode requests are only executed
{ once, no matter how many processors keypoints are active on.

      IF ((osv$keypoint_control.environment = osc$job_keypoints) OR
          (osv$keypoint_control.environment = osc$job_sample_keypoints)) AND
           NOT (osv$keypoint_control.mpo = osc$keypoints_multi_processor) THEN
        IF NOT cst_p^.xcb_p^.keypoint_enable THEN
          rb.status.normal := FALSE;
          rb.status.condition := ose$kpt_illegal_request;
          RETURN;
        IFEND;
      IFEND;
      put_stuff_in_buffer (lpid, rb);
      osp$terminate_keypoint_collect (rb.status);
    = osc$kpt_mr_go =
      IF (osv$keypoint_control.environment = osc$job_keypoints) OR
          (osv$keypoint_control.environment = osc$job_sample_keypoints) THEN
        IF NOT cst_p^.xcb_p^.keypoint_enable THEN
          rb.status.normal := FALSE;
          rb.status.condition := ose$kpt_illegal_request;
          RETURN;
        IFEND;
      IFEND;
      IF termination_in_progress THEN
        rb.status.normal := FALSE;
        rb.status.condition := ose$kpt_illegal_request;
        RETURN;
      IFEND;
      IF osv$keypoint_control.termination_status = osc$kp_term_not_stopped THEN
        osv$keypoint_control.jm := osv$keypoint_control.envjm;
        osv$keypoint_control.mm := osv$keypoint_control.envmm;
        osv$keypoint_control.active := TRUE;
        propagate_keypoint_masks (rb.status);
        IF (NOT rb.status.normal) AND (rb.status.condition = ose$fail_to_update_keyp_flags) THEN
          tmp$reissue_monitor_request;
          tmp$cause_task_switch;
        IFEND;
      ELSE
        rb.status.normal := FALSE;
        rb.status.condition := osv$keypoint_control.termination_status;
      IFEND;
    ELSE
    CASEND;
  PROCEND osp$process_job_keypoint_req;
?? TITLE := 'osp$terminate_keypoint_collect', EJECT ??

  PROCEDURE osp$terminate_keypoint_collect
    (VAR status: syt$monitor_status);

    VAR
      asid: ost$asid,
      astep: ^mmt$active_segment_table_entry,
      asti: mmt$ast_index,
      found: boolean,
      hc: integer,
      i: integer,
      ijlep: ^jmt$initiated_job_list_entry,
      ipti: integer,
      j: integer,
      lpid: integer,
      pfti: mmt$page_frame_index,
      pftis: array [1 .. osc$max_kpt_pages] of mmt$page_frame_index,
      pi: ^array [0 .. 100000] of integer,
      pkc: ^ost$processor_keypoint_control,
      sva: ost$system_virtual_address,
      trick: ost$read_register,
      xcbp: ^ost$execution_control_block,
      xcb_state: tmt$find_next_xcb_state;

    status.normal := TRUE;
    lpid := #read_register (osc$pr_processor_id);
    pkc := ^osv$keypoint_control.cpus [lpid];
    tmp$new_set_lock (keypoint_lock);
    IF NOT pkc^.active THEN
      tmp$new_clear_lock (keypoint_lock);
      RETURN;
    IFEND;
    IF osv$keypoint_control.active THEN
      mtp$error_stop ('KP - term while active');
    IFEND;
    propagate_keypoint_masks (status);
    IF (NOT status.normal) AND (status.condition = ose$fail_to_update_keyp_flags) THEN

{ Dont clear the lock before re-issueing the monitor request-it will crash when the request completes
{ normally.

      tmp$reissue_monitor_request;
      tmp$cause_task_switch;
    IFEND;
    termination_in_progress := TRUE;
    osp$process_keypoint_periodic;
    IF pkc^.io_count <> 0 THEN
      FOR j := 1 TO pkc^.io_count DO
        mmp$relink_page_frame (pkc^.io_pfti [j], mmc$pq_free);
      FOREND;
      keypoint_stats.out_count := keypoint_stats.out_count + pkc^.
            io_count;
    IFEND;

    IF pkc^.in_use_count > 0 THEN

{ clear the remainder of the collection pages

      trick.i := #read_register (osc$pr_keypoint_buffer_ptr);
      i := #offset (trick.pva);
      i := i - #offset (pkc^.collector_pva);
      IF i <> 0 THEN
        pi := pkc^.collector_pva;
        FOR j := (i DIV 8) TO ((osv$keypoint_control.max_pages * osv$page_size)
              DIV 8) - 1 DO
          pi^ [j] := 0;
        FOREND;
      IFEND;

{     flush in use pages to disk

      FOR j := 1 TO pkc^.in_use_count DO
        pkc^.io_pfti [j] := pkc^.in_use_pfti [j];
        mmp$unlink_page_from_segment (^mmv$pft_p^ [pkc^.io_pfti [j]], mmv$pft_p^
              [pkc^.io_pfti [j]].aste_p);
      FOREND;
      pkc^.io_count := pkc^.in_use_count;
      pkc^.in_use_count := 0;
      osp$process_keypoint_periodic;
      IF pkc^.io_count <> 0 THEN
        FOR j := 1 TO pkc^.io_count DO
          mmp$relink_page_frame (pkc^.io_pfti [j], mmc$pq_free);
        FOREND;
        keypoint_stats.out_count := keypoint_stats.out_count + pkc^.
              io_count;
      IFEND;
    IFEND;

    FOR j := 1 TO pkc^.avail_count DO
      mmp$relink_page_frame (pkc^.avail_pfti [j], mmc$pq_free);
    FOREND;
    keypoint_stats.out_count := keypoint_stats.out_count + pkc^.
          avail_count;
    pkc^.avail_count := 0;

    asid := mtv$monitor_segment_table.st [osc$segnum_page_table].ste.asid;
    mmp$asti (asid, asti);
    astep := ^mmv$ast_p^ [asti];
    sva.asid := asid;
    sva.offset := #OFFSET (pkc^.collector_pva);

    { Return page table entries - requires valid pft entry

  /get_avail_pages/
    FOR i := 1 TO osv$keypoint_control.max_pages DO
      mmp$get_avail_page_frame (pfti);
      IF pfti = 0 THEN
{ pages not available - return
        FOR j := 1 TO (i - 1) DO
          mmp$relink_page_frame (pftis [j], mmc$pq_free);
        FOREND;
        status.normal := FALSE;
        status.condition := ose$kpt_coll_term_mbs_error;
        tmp$new_clear_lock (keypoint_lock);
        RETURN;
      IFEND;
      mmp$relink_page_frame (pfti, mmc$pq_wired);
      mmv$pft_p^ [pfti].sva := null_sva;
      pftis [i] := pfti;
    FOREND /get_avail_pages/;

    FOR i := 1 TO osv$keypoint_control.max_pages DO
      #hash_sva (sva, ipti, hc, found);
      IF NOT found THEN
        mtp$error_stop ('KP - term #hash');
      IFEND;
      mmv$pft_p^ [pftis [i]].ijl_ordinal := astep^.ijl_ordinal;
      mmv$pft_p^ [pftis [i]].age := 1;
      mmv$pft_p^ [pftis [i]].aste_p := astep;
      mmv$pft_p^ [pftis [i]].sva := sva;
      mmv$pft_p^ [pftis [i]].pti := ipti;
      mmv$pt_p^ [ipti].rma := (pftis [i] * osv$page_size) DIV 512;
      sva.offset := sva.offset + osv$page_size;
    FOREND;

    trick.i := #read_register (osc$pr_keypoint_buffer_ptr);
    i := #offset (trick.pva);
    i := i - #offset (pkc^.collector_pva);
    IF i <> 0 THEN
      pkc^.offset := pkc^.offset - ((osv$keypoint_control.max_pages *
            osv$page_size) - i);
    IFEND;
    IF osv$keypoint_enable = osc$kpt_test_mode THEN
      pkc^.offset := 0;
    IFEND;

    trick.pva := NIL;
    trick.fill := 0;
    #write_register (osc$pr_keypoint_buffer_ptr, trick.i);
    #purge_buffer (osc$pva_purge_all_page_seg_map, pkc^.collector_pva);
    mmp$delete_page_from_monitor (pkc^.collector_pva, osv$keypoint_control.
          max_pages, status);
    #purge_buffer (osc$pva_purge_all_page_seg_map, pkc^.collector_pva);
    pkc^.active := FALSE;
    osv$keypoint_control.periodic_requested := FALSE;
    IF (osv$keypoint_control.environment = osc$job_keypoints) OR
        (osv$keypoint_control.environment = osc$job_sample_keypoints) THEN
      jmp$get_ijle_p ( osv$keypoint_control.ijlo, ijlep);
      tmp$find_next_xcb (tmc$fnx_job, ijlep, osv$keypoint_control.ijlo, xcb_state, xcbp);
      WHILE xcbp <> NIL DO
        xcbp^.keypoint_enable := FALSE;
        tmp$find_next_xcb (tmc$fnx_continue, NIL, jmv$null_ijl_ordinal, xcb_state, xcbp);
      WHILEND;
    IFEND;
    tmp$new_clear_lock (keypoint_lock);
  PROCEND osp$terminate_keypoint_collect;

?? TITLE := 'osp$process_keypoint_io_error', EJECT ??

  PROCEDURE [XDCL] osp$process_keypoint_io_error;

    tmp$new_set_lock (keypoint_lock);
    terminate_keypoint_collection (ose$kpt_coll_term_io_error);
    tmp$new_clear_lock (keypoint_lock);

  PROCEND osp$process_keypoint_io_error;
?? TITLE := 'osp$process_mtr_page_fault', EJECT ??

  PROCEDURE [XDCL] osp$process_mtr_page_fault
    (psa: ^ost$stack_frame_save_area;
     VAR halt: boolean);

    VAR
      cst_p: ^ost$cpu_state_table,
      keypoint_page_fault_status: mmt$keypoint_page_fault_status,
      lpid: integer,
      offset: integer,
      pkc: ^ost$processor_keypoint_control,
      p_opcode: ^0 .. 0ff(16),
      status: syt$monitor_status;


    keypoint_stats.mtr_pf := keypoint_stats.mtr_pf + 1;
    p_opcode := #address (1, psa^.minimum_save_area.p_register.pva.seg, psa^.
          minimum_save_area.p_register.pva.offset);
    IF p_opcode^ <> 0b1(16) THEN
      halt := TRUE;
      RETURN;
    IFEND;
    IF osv$keypoint_enable = osc$kpt_test_mode THEN
      keypoint_stats.mtr_pf_skip := keypoint_stats.mtr_pf_skip + 1;
      psa^.minimum_save_area.p_register.pva.offset := psa^.minimum_save_area.
            p_register.pva.offset + 4;
      halt := FALSE;
      RETURN;
    IFEND;
    IF NOT osv$keypoint_control.active THEN
      mtp$cst_p (cst_p);
      #write_register (osc$pr_clear_keypoint_enable,
            osc$pr_clear_keypoint_enable);
      IF cst_p^.xcb_p <> NIL THEN
        cst_p^.xcb_p^.keypoint_register_enable := FALSE;
      IFEND;
      keypoint_stats.mtr_pf_skip := keypoint_stats.mtr_pf_skip + 1;
      psa^.minimum_save_area.p_register.pva.offset := psa^.minimum_save_area.
            p_register.pva.offset + 4;
    ELSE
      lpid := #read_register (osc$pr_processor_id);
      pkc := ^osv$keypoint_control.cpus [lpid];
      offset := #offset (pkc^.collector_pva) + (osv$keypoint_control.max_pages * osv$page_size);
      osp$process_keypoint_page_fault (offset, keypoint_page_fault_status);
      IF keypoint_page_fault_status <> mmc$kpfs_normal THEN
        psa^.minimum_save_area.p_register.pva.offset := psa^.minimum_save_area.
              p_register.pva.offset + 4;
      IFEND;
    IFEND;
    halt := FALSE;
  PROCEND osp$process_mtr_page_fault;
?? TITLE := 'osp$executing_for_other_cpu', EJECT ??
  FUNCTION [INLINE] osp$executing_for_other_cpu
    (    processor_id: ost$processor_id): boolean;

    IF processor_id = #read_register(osc$pr_processor_id) THEN
      osp$executing_for_other_cpu := FALSE;
    ELSE
      osp$executing_for_other_cpu := TRUE;
    IFEND;

  FUNCEND osp$executing_for_other_cpu;

?? TITLE := 'osp$alert_keyp_cpu_state_chng ', EJECT ??

  PROCEDURE [XDCL] osp$alert_keyp_cpu_state_chng
    (    cpu_with_state_change: ost$processor_id);

  VAR
    actual: integer,
    cpu: ost$processor_id,
    cst_p: ^ost$cpu_state_table,
    i: integer,
    ignore_status: syt$monitor_status,
    ijlep: ^jmt$initiated_job_list_entry,
    processor_selections: ost$processor_id_set,
    pseudo_rb: ost$rb_keypoint_request,
    result: boolean,
    status: syt$monitor_status,
    xcbp: ^ost$execution_control_block,
    xcb_state: tmt$find_next_xcb_state;

    IF termination_in_progress THEN
      RETURN;
    IFEND;
    xcbp := NIL;
    tmp$new_set_lock (keypoint_lock);
    IF osv$keypoint_control.ijlo <> jmv$null_ijl_ordinal THEN
      IF (cpu_with_state_change <= osv$keypoint_control.last_active_processor) AND
        (cpu_with_state_change >= osv$keypoint_control.first_active_processor) THEN
        termination_in_progress := TRUE;
        FOR cpu := osv$keypoint_control.first_active_processor TO
               osv$keypoint_control.last_active_processor DO
          IF osv$keypoint_control.active THEN
            osv$keypoint_control.jm := $ost$keypoint_mask [ ];
            osv$keypoint_control.mm := $ost$keypoint_mask [ ];
            osv$keypoint_control.active := FALSE;
            IF osp$executing_for_other_cpu (cpu_with_state_change) THEN
              cst_p := ^mtv$cst0 [cpu_with_state_change];
              change_tasks_keypoint_masks (FALSE, cst_p, ignore_status);
            ELSE
              propagate_keypoint_masks (ignore_status);
              pseudo_rb.kpt.microsecond_clock := #free_running_clock (0);
              pseudo_rb.kpt.user_data := '  ';
              pseudo_rb.kpt.keypoint.clock := pseudo_rb.kpt.microsecond_clock MOD
                 10000000(16);
              pseudo_rb.kpt.keypoint.keypoint_class := 15;
              pseudo_rb.kpt.keypoint.keypoint_code := osc$keypoint_cl15_stop;
              put_stuff_in_buffer (cpu, pseudo_rb);
            IFEND;
          IFEND;
        FOREND;



        IF NOT osp$executing_for_other_cpu (cpu_with_state_change) THEN
          FOR cpu := osv$keypoint_control.first_active_processor TO
                osv$keypoint_control.last_active_processor DO
            pseudo_rb.kpt.microsecond_clock := #free_running_clock (0);
            pseudo_rb.kpt.user_data := '  ';
            pseudo_rb.kpt.keypoint.clock := pseudo_rb.kpt.microsecond_clock MOD
                 10000000(16);
            pseudo_rb.kpt.keypoint.keypoint_class := 15;
            pseudo_rb.kpt.keypoint.keypoint_code := osc$keypoint_cl15_release;
            put_stuff_in_buffer (cpu, pseudo_rb);
            osp$terminate_keypoint_collect (ignore_status);
          FOREND;
        IFEND;

  { Reset the processor_selections if necessary.}
  { Need to do this for all tasks in the job.

        IF (osv$keypoint_control.environment = osc$job_keypoints) OR
              (osv$keypoint_control.environment = osc$job_sample_keypoints) THEN
          jmp$get_ijle_p (osv$keypoint_control.ijlo, ijlep);
          IF osv$keypoint_control.processor_select_flag THEN
            processor_selections := $ost$processor_id_set [ ];
            FOR cpu := 0 TO 7 DO
              IF cpu IN osv$keypoint_control.processor_selections THEN
                processor_selections := processor_selections + $ost$processor_id_set [cpu];
              IFEND;
            FOREND;
          ELSE
            IF ijlep^.job_scheduler_data.job_class = jmc$maintenance_job_class THEN
              processor_selections := mtv$scb.cpus.logically_on;
            ELSE
              processor_selections := mtv$scb.cpus.available_for_use;
            IFEND;
          IFEND;
          tmp$find_next_xcb (tmc$fnx_job, ijlep, osv$keypoint_control.ijlo, xcb_state, xcbp);
          WHILE xcbp <> NIL DO
            xcbp^.keypoint_enable := FALSE;
            xcbp^.processor_selections := processor_selections;
            tmp$set_system_flag (xcbp^.global_task_id, osc$keyp_environ_change_flag, ignore_status);
            tmp$find_next_xcb (tmc$fnx_continue, NIL, jmv$null_ijl_ordinal, xcb_state, xcbp);
          WHILEND;
        IFEND;

{ If the job collecting keypoints hasn't been notified about the change in keypoint environement (done if
{ collecting job/job sample keypoints above) inform the $JOBMONITOR task in the job.

        IF xcbp = NIL THEN
          jmp$get_ijle_p (osv$keypoint_control.ijlo, ijlep);
          tmp$set_system_flag (ijlep^.job_monitor_taskid, osc$keyp_environ_change_flag, ignore_status);
        IFEND;

        syv$pmf_cb_rm_word_address := 0;
{       FREE osv$ppu_keypoint_control IN osv$mainframe_wired_cb_heap^;
        osv$keypoint_control.jsn := '     ';
        osv$keypoint_control.first_active_processor := -2;
        osv$keypoint_control.last_active_processor := -1;
        osv$keypoint_control.ijlo := jmv$null_ijl_ordinal;
        osv$keypoint_control.processor_select_flag := FALSE;
        syv$perf_keypoints_enabled.memory_keypoints := FALSE;
        syv$perf_keypoints_enabled.heap_keypoints := FALSE;
        syv$perf_keypoints_enabled.swapping_keypoints := FALSE;
        syv$perf_keypoints_enabled.aging_keypoints := FALSE;
        syv$perf_keypoints_enabled.swapping_stack_trace := FALSE;
        syv$perf_keypoints_enabled.aging_stack_trace := FALSE;
        syv$perf_keypoints_enabled.disk_cache := FALSE;
        syv$perf_keypoints_enabled.command_keypoints := FALSE;
        osp$fetch_locked_variable (osv$keypoint_control.lock, i);
        osp$set_locked_variable (osv$keypoint_control.lock, i, 0, actual, result);
      IFEND;
    IFEND;

    tmp$new_clear_lock (keypoint_lock);
  PROCEND osp$alert_keyp_cpu_state_chng;
?? TITLE := 'put_stuff_in_buffer', EJECT ??

  PROCEDURE put_stuff_in_buffer
    (    lpid: integer;
     VAR rb: ost$rb_keypoint_request);

    VAR
      cbo: integer,
      dp: ^cell,
      keypoint_page_fault_status: mmt$keypoint_page_fault_status,
      l: integer,
      mbs: integer,
      modl: integer,
      offset: integer,
      pkc: ^ost$processor_keypoint_control,
      pr: ost$read_register,
      sp: ^cell,
      status: syt$monitor_status,
      te: 0 .. 3,
      xl: integer;

    IF (NOT cl15_enabled) OR (osv$keypoint_enable = osc$kpt_test_mode) THEN
      RETURN;
    IFEND;

    l := #SIZE (rb.kpt);
    sp := #LOC (rb.kpt);
    mbs := osv$keypoint_control.max_pages * osv$page_size;

    i#mtr_disable_traps (te);

  /copy/
    BEGIN
      REPEAT
        IF osv$keypoint_control.termination_status <> osc$kp_term_not_stopped
              THEN
          EXIT /copy/;
        IFEND;
        pr.i := #read_register (osc$pr_keypoint_buffer_ptr);
        dp := pr.pva;
        IF (l MOD 8) <> 0 THEN
          modl := l + (8 - (l MOD 8));
        ELSE
          modl := l;
        IFEND;
        cbo := #offset (dp) - #offset (osv$keypoint_control.cpus
              [lpid].collector_pva);
        IF (mbs - cbo) >= modl THEN
          i#move (sp, dp, l);
          dp := #address (#ring (dp), #segment (dp), #offset (dp) + modl);
          pr.pva := dp;
          pr.fill := 0;
          #write_register (osc$pr_keypoint_buffer_ptr, pr.i);
          l := 0;
        ELSE
          xl := mbs - cbo;
          IF xl > 0 THEN
            i#move (sp, dp, xl);
            dp := #address (#ring (dp), #segment (dp), #offset (dp) + xl);
            pr.pva := dp;
            pr.fill := 0;
            #write_register (osc$pr_keypoint_buffer_ptr, pr.i);
            l := l - xl;
            sp := #address (#ring (sp), #segment (sp), #offset (sp) + xl);
          IFEND;
          pkc := ^osv$keypoint_control.cpus [lpid];
          offset := #offset (pkc^.collector_pva) + (osv$keypoint_control.max_pages * osv$page_size);
          osp$process_keypoint_page_fault (offset, keypoint_page_fault_status);
          IF keypoint_page_fault_status <> mmc$kpfs_normal THEN
            rb.status.normal := FALSE;
            EXIT /copy/;
          IFEND;
        IFEND;
      UNTIL l = 0;
    END /copy/;
    i#mtr_restore_traps (te);
  PROCEND put_stuff_in_buffer;
?? OLDTITLE, OLDTITLE ??
MODEND osm$monitor_keypoint_support
