?? RIGHT := 110, LEFT := 1 ??
MODULE tmm$mtr_flag_signal_functions;
?? RIGHT := 110, LEFT := 1 ??

{ PURPOSE:
{   This module processes flag and signal handling job mode monitor requests and monitor mode requests.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc mtc$job_fixed_segment
*copyc pme$hung_recipient_task
*copyc tme$monitor_mode_exceptions
*copyc mmt$page_map_offsets
*copyc ost$rb_system_error
*copyc ost$wait
*copyc tmt$broken_task_monitor_fault
*copyc tmt$mcr_faults
*copyc tmt$rb_ready_task
*copyc tmt$rb_ready_task_list
*copyc tmt$rb_send_signal
*copyc tmt$rb_set_system_flag
*copyc tmt$rb_wait
?? POP ??
*copyc dpp$display_error
*copyc jmp$unlock_ajl
*copyc jmp$unlock_ajl_with_lock
*copyc mmp$fetch_stack_segment_info
*copyc mtf$cst_p
*copyc mtp$error_stop
*copyc mtp$set_status_abnormal
*copyc mtp$step_unstep_system
*copyc tmp$check_taskid_with_lock_set
*copyc tmp$clear_lock
*copyc tmp$delay
*copyc tmp$find_xcb
*copyc tmp$get_xcb_p
*copyc tmp$set_lock
*copyc tmp$set_task_list_ready
*copyc tmp$set_task_ready
*copyc jmv$ajl_p
*copyc jmv$system_ijl_ordinal
*copyc mtv$halt_cpu_ring_number
*copyc mtv$scb
*copyc mtv$sys_core_init_complete
*copyc tmv$null_global_task_id
*copyc tmv$ptl_lock
*copyc tmv$ptl_p
*copyc tmv$system_job_monitor_gtid
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

{  Define arbitrary constant that is used to check if there is enough space in SFSA of current
{  task to terminate it.

  CONST
    task_termination_stack_area = 30000;

{Define constants for recognizing hung tasks.

  VAR
    tmv$halt_on_hung_task: [XDCL, #GATE] boolean := FALSE,
    tmv$system_debug_ring: [XDCL, #GATE] integer := 0,
    tmv$system_debug_segment: [XDCL, #GATE] integer := 0,
    tmv$job_debug_ring_p: [XDCL, #GATE] ^ost$ring := NIL,
    tmv$system_error_hang_count: [XDCL, #GATE] 0 .. 0ffffffff(16) := 6;

?? OLDTITLE ??
?? NEWTITLE := '[xdcl] TMP$SET_MONITOR_FLAG', EJECT ??

  PROCEDURE [XDCL] tmp$set_monitor_flag
    (    task_id {input} : ost$global_task_id;
         flag_id {input} : syt$monitor_flag;
     VAR status {output} : syt$monitor_status);

    VAR
      cst_p: ^ost$cpu_state_table;

{ If it is the current task, set the free flag in UCR.
    tmp$set_lock (tmv$ptl_lock{, mtc$ignore});

    tmp$check_taskid_with_lock_set (task_id, tmc$opt_return, status);
    IF NOT status.normal THEN
      tmp$clear_lock (tmv$ptl_lock);
      RETURN; {----->
    IFEND;

    cst_p := mtf$cst_p ();
    IF task_id = cst_p^.taskid THEN
      cst_p^.xcb_p^.xp.user_condition_register := cst_p^.xcb_p^.xp.user_condition_register +
            $ost$user_conditions [osc$free_flag];
      cst_p^.xcb_p^.monitor_flags := cst_p^.xcb_p^.monitor_flags + $syt$monitor_flags [flag_id];
      IF tmv$ptl_p^ [task_id.index].new_task_status < tmc$ts_first_ready_uncond THEN
        tmv$ptl_p^ [task_id.index].new_task_status := tmc$ts_null;
      IFEND;
      tmp$clear_lock (tmv$ptl_lock);
      RETURN; {----->
    IFEND;

    IF flag_id IN tmv$ptl_p^ [task_id.index].monitor_flags THEN
      tmp$clear_lock (tmv$ptl_lock);
      RETURN; {----->
    IFEND;

{ Set monitor flag in PTL.

    tmv$ptl_p^ [task_id.index].monitor_flags := tmv$ptl_p^ [task_id.index].monitor_flags +
          $syt$monitor_flags [flag_id];
    tmp$set_task_ready (task_id, 0 {readying_task_priority} , tmc$rc_ready_conditional);
    tmp$clear_lock (tmv$ptl_lock);

  PROCEND tmp$set_monitor_flag;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] TMP$SET_SYSTEM_FLAG', EJECT ??

  PROCEDURE [XDCL] tmp$set_system_flag
    (    task_id {input} : ost$global_task_id;
         flag_id {input} : ost$system_flag;
     VAR status {output} : syt$monitor_status);

*copyc tmh$set_system_flag

    VAR
      cst_p: ^ost$cpu_state_table,
      ijle_p: ^jmt$initiated_job_list_entry,
      xcb_p: ^ost$execution_control_block;

{ If it is the current task, set the free flag in UCR.
    tmp$set_lock (tmv$ptl_lock{, mtc$ignore});

    tmp$check_taskid_with_lock_set (task_id, tmc$opt_return, status);
    IF NOT status.normal THEN
      tmp$clear_lock (tmv$ptl_lock);
      RETURN; {----->
    IFEND;

    cst_p := mtf$cst_p ();
    IF task_id = cst_p^.taskid THEN
      xcb_p := cst_p^.xcb_p;
      IF (xcb_p^.task_is_terminating) AND (flag_id <> mmc$failed_file_alloc_flag) THEN
        mtp$set_status_abnormal ('TM', tme$invalid_global_taskid, status);
      ELSE
        xcb_p^.xp.user_condition_register := xcb_p^.xp.user_condition_register +
              $ost$user_conditions [osc$free_flag];
        xcb_p^.system_flags := xcb_p^.system_flags + $tmt$system_flags [flag_id];
        xcb_p^.monitor_flags := xcb_p^.monitor_flags + $syt$monitor_flags [tmc$mf_cause_job_free_flag_trap];
        xcb_p^.wait_inhibited := TRUE;
        IF tmv$ptl_p^ [task_id.index].new_task_status < tmc$ts_first_ready_uncond THEN
          tmv$ptl_p^ [task_id.index].new_task_status := tmc$ts_null;
        IFEND;
      IFEND;
      tmp$clear_lock (tmv$ptl_lock);
      RETURN; {----->
    IFEND;

    IF flag_id IN tmv$ptl_p^ [task_id.index].system_flags THEN
      tmp$clear_lock (tmv$ptl_lock);
      RETURN; {----->
    IFEND;

    tmp$get_xcb_p (task_id, xcb_p, ijle_p);
    IF (xcb_p <> NIL) AND xcb_p^.task_is_terminating THEN
      status.normal := FALSE;
      status.condition := tme$invalid_global_taskid;
      jmp$unlock_ajl_with_lock (ijle_p);
      tmp$clear_lock (tmv$ptl_lock);
      RETURN; {----->
    IFEND;
    IF (xcb_p <> NIL) THEN
      jmp$unlock_ajl_with_lock (ijle_p);
    IFEND;

{ Set system flag in PTL.

    tmv$ptl_p^ [task_id.index].system_flags := tmv$ptl_p^ [task_id.index].
          system_flags + $tmt$system_flags [flag_id];
    IF (tmv$ptl_p^ [task_id.index].ptl_flags.wait_inhibited <> tmc$wi_wait_selected_r3) THEN
      tmv$ptl_p^ [task_id.index].monitor_flags := tmv$ptl_p^ [task_id.index].monitor_flags +
            $syt$monitor_flags [tmc$mf_cause_job_free_flag_trap];
    IFEND;
    tmp$set_task_ready (task_id, 0 {readying_task_priority} , tmc$rc_ready_conditional_wi);
    tmp$clear_lock (tmv$ptl_lock);

  PROCEND tmp$set_system_flag;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] TMP$FLAG_ALL_TASKS', EJECT ??

  PROCEDURE [XDCL] tmp$flag_all_tasks
    (    flag_id {input} : ost$system_flag;
     VAR status {output} : syt$monitor_status);

*copyc tmh$flag_all_tasks

    VAR
      i: ost$task_index,
      task_id: ost$global_task_id,
      cst_p: ^ost$cpu_state_table;

    status.normal := TRUE;

    tmp$set_lock (tmv$ptl_lock{, mtc$ignore});
    FOR i := 1 TO UPPERBOUND (tmv$ptl_p^) DO
      IF tmv$ptl_p^ [i].status <> tmc$ts_null THEN

        task_id.index := i;
        task_id.seqno := tmv$ptl_p^ [i].sequence_number;

{  If it is the current task, set the free flag in UCR.

        cst_p := mtf$cst_p ();
        IF task_id = cst_p^.taskid THEN
          cst_p^.xcb_p^.xp.user_condition_register := cst_p^.xcb_p^.xp.user_condition_register +
                $ost$user_conditions [osc$free_flag];
          cst_p^.xcb_p^.system_flags := cst_p^.xcb_p^.system_flags + $tmt$system_flags [flag_id];
          cst_p^.xcb_p^.monitor_flags := cst_p^.xcb_p^.monitor_flags +
                $syt$monitor_flags [tmc$mf_cause_job_free_flag_trap];
          cst_p^.xcb_p^.wait_inhibited := TRUE;
          IF tmv$ptl_p^ [task_id.index].new_task_status < tmc$ts_first_ready_uncond THEN
            tmv$ptl_p^ [task_id.index].new_task_status := tmc$ts_null;
          IFEND;
        IFEND;

{ Set system flag in PTL.

        tmv$ptl_p^ [task_id.index].system_flags := tmv$ptl_p^ [task_id.index].system_flags +
              $tmt$system_flags [flag_id];
        IF (tmv$ptl_p^ [task_id.index].ptl_flags.wait_inhibited <> tmc$wi_wait_selected_r3) THEN
          tmv$ptl_p^ [task_id.index].monitor_flags := tmv$ptl_p^ [task_id.index].monitor_flags +
                $syt$monitor_flags [tmc$mf_cause_job_free_flag_trap];
        IFEND;
        tmp$set_task_ready (task_id, 0 {readying_task_priority} , tmc$rc_ready_conditional_wi);
      IFEND;
    FOREND;
    tmp$clear_lock (tmv$ptl_lock);

  PROCEND tmp$flag_all_tasks;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] TMP$MONITOR_FLAG_JOB_TASKS', EJECT ??

  PROCEDURE [XDCL] tmp$monitor_flag_job_tasks
    (    monitor_flag_id: syt$monitor_flag;
         ijle_p: ^jmt$initiated_job_list_entry);

    VAR
      taskid: ost$global_task_id,
      status: syt$monitor_status;

    tmp$set_lock (tmv$ptl_lock{, mtc$ignore});
    taskid := ijle_p^.job_monitor_taskid;

    WHILE taskid.index <> 0 DO
      taskid.seqno := tmv$ptl_p^ [taskid.index].sequence_number;
      tmp$set_monitor_flag (taskid, monitor_flag_id, status);
      taskid.index := tmv$ptl_p^ [taskid.index].ijl_thread;
    WHILEND;

    tmp$clear_lock (tmv$ptl_lock);
  PROCEND tmp$monitor_flag_job_tasks;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] TMP$MTR_READY_TASK', EJECT ??

  PROCEDURE [XDCL] tmp$mtr_ready_task
    (VAR rb {input, output} : tmt$rb_ready_task);

*copyc tmh$mtr_ready_task
*copyc tmhrrt

    VAR
      readying_task_priority: jmt$dispatching_priority,
      cst_p: ^ost$cpu_state_table;

    tmp$set_lock (tmv$ptl_lock{, mtc$ignore});
    tmp$check_taskid_with_lock_set (rb.task_id, tmc$opt_return, rb.status);
    IF rb.status.normal = FALSE THEN
      tmp$clear_lock (tmv$ptl_lock);
      RETURN; {----->
    IFEND;

    cst_p := mtf$cst_p ();

    IF cst_p^.xcb_p^.dispatching_priority >= tmv$ptl_p^ [cst_p^.xcb_p^.global_task_id.index].
          readying_task_priority THEN
      readying_task_priority := cst_p^.xcb_p^.dispatching_priority;
    ELSE
      readying_task_priority := tmv$ptl_p^ [cst_p^.xcb_p^.global_task_id.index].readying_task_priority;
    IFEND;

    tmp$set_task_ready (rb.task_id, readying_task_priority, tmc$rc_ready_conditional_wi);
    tmp$clear_lock (tmv$ptl_lock);

  PROCEND tmp$mtr_ready_task;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] tmp$mtr_ready_task_list', EJECT ??

  PROCEDURE [XDCL] tmp$mtr_ready_task_list
    (VAR rb {input, output} : tmt$rb_ready_task_list);

    VAR
      cst_p: ^ost$cpu_state_table,
      i: integer,
      readying_task_priority: jmt$dispatching_priority,
      taskid: ost$global_task_id;

    rb.status.normal := TRUE;
    IF (rb.highest_index < 0) OR (rb.taskid_list_p = NIL) THEN
      RETURN; {----->

    ELSEIF (rb.taskid_response_list_p = NIL)
{     } OR (UPPERBOUND (rb.taskid_response_list_p^) <> UPPERBOUND (rb.taskid_list_p^)) THEN

      mtp$set_status_abnormal ('TM', tme$ready_task_list_size_error, rb.status);
      RETURN; {----->
    IFEND;

    tmp$set_lock (tmv$ptl_lock{, mtc$ignore});

{Check Task IDs.
    rb.bad_task_id_found := FALSE;
    rb.bad_task_id_index := 0;

    FOR i := rb.highest_index DOWNTO 0 DO
      taskid := rb.taskid_list_p^ [i];

      IF (taskid <> tmv$null_global_task_id)
{      } AND (taskid.index <= UPPERBOUND (tmv$ptl_p^))
{      } AND (tmv$ptl_p^ [taskid.index].sequence_number = taskid.seqno)
{      } AND (tmv$ptl_p^ [taskid.index].status <> tmc$ts_null) THEN

        rb.taskid_response_list_p^ [i] := pmc$rtr_ready_task_successful;
      ELSE
        rb.taskid_response_list_p^ [i] := pmc$rtr_unknown_recipient_task;
        rb.bad_task_id_found := TRUE;
        rb.bad_task_id_index := i;
      IFEND;
    FOREND;

    cst_p := mtf$cst_p ();

    IF cst_p^.xcb_p^.dispatching_priority >= tmv$ptl_p^ [cst_p^.xcb_p^.global_task_id.index].
          readying_task_priority THEN
      readying_task_priority := cst_p^.xcb_p^.dispatching_priority;
    ELSE
      readying_task_priority := tmv$ptl_p^ [cst_p^.xcb_p^.global_task_id.index].readying_task_priority;
    IFEND;

    tmp$set_task_list_ready (rb.highest_index, rb.taskid_list_p^, rb.taskid_response_list_p^,
          readying_task_priority);
    tmp$clear_lock (tmv$ptl_lock);

  PROCEND tmp$mtr_ready_task_list;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] TMP$SEND_SIGNAL', EJECT ??

  PROCEDURE [XDCL] tmp$send_signal
    (    task_id {input} : ost$global_task_id;
         signal {input} : pmt$signal;
     VAR status {output} : syt$monitor_status);

*copyc tmh$send_signal

    VAR
      i {signal array index} : 1 .. tmc$maximum_signals,
      ijle_p: ^jmt$initiated_job_list_entry,
      xcb_p: ^ost$execution_control_block;

    tmp$find_xcb (task_id, xcb_p, ijle_p, status);
    IF status.normal = FALSE THEN
      RETURN; {----->
    IFEND;

  /access_xcb/
    BEGIN
      IF xcb_p^.task_is_terminating THEN
        status.normal := FALSE;
        status.condition := tme$invalid_global_taskid;
        EXIT /access_xcb/; {----->
      IFEND;

      IF xcb_p^.system_error_count >= tmv$system_error_hang_count THEN
        status.normal := FALSE;
        status.condition := pme$hung_recipient_task;
        EXIT /access_xcb/; {----->
      IFEND;

    /find_free_signal_buffer/
      BEGIN

      /free_buffer_loop/
        FOR i := 1 TO tmc$maximum_signals DO
          IF xcb_p^.signals.reserved [i] = FALSE THEN
            EXIT /find_free_signal_buffer/; {----->
          IFEND;
        FOREND /free_buffer_loop/;
        status.normal := FALSE;
        status.condition := tme$mtr_signal_buffers_full;
        EXIT /access_xcb/; {----->
      END /find_free_signal_buffer/;

{  Place signal in free signal buffer.

      xcb_p^.signals.reserved [i] := TRUE;
      xcb_p^.signals.present [i] := TRUE;

      xcb_p^.signals.buffer [i].originator := mtf$cst_p ()^.taskid;
      xcb_p^.signals.buffer [i].signal := signal;

      IF tmv$ptl_p^ [task_id.index].ptl_flags.wait_inhibited <> tmc$wi_wait_selected_r3 THEN

{  Set task status to ready and set free flag in specified tasks user condition
{  register to invoke trap handler when the task gets the CPU.

        xcb_p^.wait_inhibited := TRUE;
        tmp$set_monitor_flag (task_id, tmc$mf_cause_job_free_flag_trap, status);
      ELSE
        tmp$set_task_ready (task_id, 0 {readying_task_priority} , tmc$rc_ready_conditional);
      IFEND;

    END /access_xcb/;

    jmp$unlock_ajl (ijle_p);

  PROCEND tmp$send_signal;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] TMP$MTR_SET_SYSTEM_FLAG', EJECT ??

  PROCEDURE [XDCL] tmp$mtr_set_system_flag
    (VAR rb {input, output} : tmt$rb_set_system_flag);

*copyc tmh$mtr_set_system_flag
*copyc tmhrssf

    tmp$set_system_flag (rb.task_id, rb.flag_id, rb.status);

  PROCEND tmp$mtr_set_system_flag;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] TMP$MTR_SEND_SIGNAL', EJECT ??

  PROCEDURE [XDCL] tmp$mtr_send_signal
    (VAR rb {input,output} : tmt$rb_send_signal);

*copyc tmh$mtr_send_signal

    tmp$send_signal (rb.task_id, rb.signal, rb.status);

  PROCEND tmp$mtr_send_signal;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] TMP$PROCESS_TASK_MCR_FAULT', EJECT ??

  PROCEDURE [XDCL] tmp$process_task_mcr_fault;

{ Purpose:
{   This procedure is called by the monitor interrupt processor to process an MCR fault from a
{   task if the MCR fault was selected by the task to be processed in job mode.

    VAR
      fault: ost$monitor_fault,
      mcr_fault_p: ^tmt$mcr_faults,
      xcb_p: ^ost$execution_control_block,
      zero_pva: [STATIC, READ] ost$pva := [0, 0, 0];


{Copy the fault information for the task's XCB to the signal record.

    xcb_p := mtf$cst_p ()^.xcb_p;
    fault.identifier := tmc$mcr_fault;
    mcr_fault_p := #LOC (fault.contents);
    mcr_fault_p^.faults := xcb_p^.xp.monitor_condition_register;
    mcr_fault_p^.untranslatable_pointer := xcb_p^.xp.untranslatable_pointer;


{Send the Monitor Fault to the task.

    send_monitor_fault (xcb_p, ^fault, 'Job mode MCR fault', TRUE);


{Reset the XCB. Clear the UTP and MCR.

    xcb_p^.xp.untranslatable_pointer := zero_pva;

  PROCEND tmp$process_task_mcr_fault;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] TMP$PROCESS_UNKNOWN_REQ_FAULT', EJECT ??

  PROCEDURE [XDCL] tmp$process_unknown_req_fault;

*copyc tmh$process_unknown_req_fault

    VAR
      fault: ost$monitor_fault,
      xcb_p: ^ost$execution_control_block;

{  Set up the fault information in the signal block.

    xcb_p := mtf$cst_p ()^.xcb_p;
    fault.identifier := tmc$unknown_system_req_fault;

{  Send the monitor fault to the task.

    send_monitor_fault (xcb_p, ^fault, 'invalid monitor request', TRUE);

  PROCEND tmp$process_unknown_req_fault;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] TMP$SEND_MONITOR_FAULT', EJECT ??

{  PURPOSE:
{    The purpose of this procedure is to place a monitor fault in the
{    monitor fault buffer of the specified task.
{
{  NOTE:
{    The first monitor fault buffer is reserved for 'broken_task_monitor_fault'.
{    this procedure will start with the second monitor fault buffer when
{    searching for a free buffer.

  PROCEDURE [XDCL] tmp$send_monitor_fault
    (    task_id {input} : ost$global_task_id;
         monitor_fault_p {input} : ^ost$monitor_fault;
         check_traps_enabled {input} : boolean);

    VAR
      ijle_p: ^jmt$initiated_job_list_entry,
      xcb_p: ^ost$execution_control_block;

    tmp$get_xcb_p (task_id, xcb_p, ijle_p);
    send_monitor_fault (xcb_p, monitor_fault_p, 'monitor fault', check_traps_enabled);
    jmp$unlock_ajl (ijle_p);

  PROCEND tmp$send_monitor_fault;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] TMP$MTR_PROCESS_SYSTEM_ERROR', EJECT ??

  PROCEDURE [XDCL] tmp$mtr_process_system_error
    (    rb: ost$rb_system_error);

*copyc oshrser

    VAR
      cst_p: ^ost$cpu_state_table,
      fault: ost$monitor_fault,
      error_message: string (80),
      broken_task_fault_p: ^tmt$broken_task_monitor_fault;

    cst_p := mtf$cst_p ();

    IF NOT mtv$sys_core_init_complete OR (cst_p^.xcb_p^.xp.p_register.pva.ring = 1) AND rb.fatal THEN
      error_message (1, 10) := 'VEOS1100- ';
      error_message (11, * ) := rb.text;
      mtp$step_unstep_system (syc$ic_fatal_software_error, error_message (1, 72));
    IFEND;

    fault.identifier := tmc$broken_task_fault_id;
    broken_task_fault_p := #LOC (fault.contents);
    broken_task_fault_p^.broken_task_condition := tmc$btc_system_error;
    broken_task_fault_p^.trap_enable := cst_p^.xcb_p^.xp.trap_enable;
    broken_task_fault_p^.status_p := rb.status_p;
    broken_task_fault_p^.text_p := rb.text_p;
    broken_task_fault_p^.caller_p_register := rb.caller_p_register;
    error_message (1, * ) := rb.text;

    send_monitor_fault (cst_p^.xcb_p, ^fault, error_message, TRUE);

  PROCEND tmp$mtr_process_system_error;
?? OLDTITLE ??
?? NEWTITLE := 'SEND_MONITOR_FAULT', EJECT ??

  PROCEDURE send_monitor_fault
    (    xcb_p {input} : ^ost$execution_control_block;
         monitor_fault_p {input} : ^ost$monitor_fault;
         mtr_flt_message {input} : string ( * ),
         check_traps_enabled {input} : boolean);

{  PURPOSE:
{    The purpose of this procedure is to place the monitor fault into free
{    monitor fault buffer of specified task.  The free flag is set to preempt
{    specified task execution and process the monitor fault next time task executes.
{
{  NOTE:
{    The first monitor fault buffer is reserved for sending monitor fault to
{    task to inform it that it is considered a broken task.  This is to ensure
{    that a buffer full condition will never occur when a task is broken.
{    It is assumed the specified task is in ready status.
{
{    If broken task processing aborts (in job mode), we will hang the task
{    unless it is a critical task or has system tables locked, in which case
{    we will halt the system.  We will not recurse back through here.
{
{    If a task is broken tmv$system_error_hang_count different times it
{    will be considered a hung task.  It will be processed as if broken
{    task processing had aborted.  (See above.)

    VAR
      i: 1 .. tmc$maximum_monitor_faults + 1,
      fault_contents_p: ^tmt$broken_task_monitor_fault,
      broken_task: boolean,
      fault: ost$monitor_fault,
      halt_message: string (72),
      jdr_p: ^ost$ring,
      status: syt$monitor_status;

    IF NOT mtv$sys_core_init_complete OR (xcb_p^.global_task_id = tmv$system_job_monitor_gtid) THEN
      halt_message (1, 10) := 'VEOS1100- ';
      halt_message (11, * ) := mtr_flt_message;
      mtp$step_unstep_system (syc$ic_fatal_software_error, halt_message (1, 72));
    IFEND;

    IF ((xcb_p^.xp.p_register.pva.ring <= mtv$halt_cpu_ring_number) OR
          (xcb_p^.xp.p_register.pva.ring <= mtv$system_haltring) AND
          (tmv$ptl_p^ [xcb_p^.global_task_id.index].ijl_ordinal = jmv$system_ijl_ordinal)) AND
          (check_traps_enabled) THEN
      halt_message (1, 10) := 'VEOS9920- ';
      halt_message (11, * ) := mtr_flt_message;
      dpp$display_error ('Software Err below Halt Ring, initiating Software Breakpoint');
      mtv$scb.nos_180_status.system_status.step_status_block.requested_status := mtc$stepped_system;
      mtp$step_unstep_system (syc$ic_software_breakpoint, halt_message);
    IFEND;

{  Set up the broken task fault.

    fault.identifier := tmc$broken_task_fault_id;
    fault.pva := xcb_p^.xp.p_register.pva;
    fault.a0 := xcb_p^.xp.a0_dynamic_space_pointer;
    fault.a1 := xcb_p^.xp.a1_current_stack_frame;
    fault.a2 := xcb_p^.xp.a2_previous_save_area;
    fault_contents_p := #LOC (fault.contents);
    fault_contents_p^.p := xcb_p^.xp.p_register;
    fault_contents_p^.a0 := xcb_p^.xp.a0_dynamic_space_pointer;
    fault_contents_p^.trap_enable := xcb_p^.xp.trap_enable;
    fault_contents_p^.monitor_condition_register := xcb_p^.xp.monitor_condition_register;
    fault_contents_p^.user_condition_register := xcb_p^.xp.user_condition_register;
    fault_contents_p^.monitor_fault_id := monitor_fault_p^.identifier;

    check_repair_trap_mechanism (xcb_p, check_traps_enabled, broken_task,
          fault_contents_p^.broken_task_condition);

    i := 2;
    WHILE (i <= tmc$maximum_monitor_faults) AND (xcb_p^.monitor_faults.present [i]) DO
      i := i + 1;
    WHILEND;

    IF i <= tmc$maximum_monitor_faults THEN
      xcb_p^.monitor_faults.buffer [i] := monitor_fault_p^;
      xcb_p^.monitor_faults.buffer [i].pva := xcb_p^.xp.p_register.pva;
      xcb_p^.monitor_faults.buffer [i].a0 := xcb_p^.xp.a0_dynamic_space_pointer;
      xcb_p^.monitor_faults.buffer [i].a1 := xcb_p^.xp.a1_current_stack_frame;
      xcb_p^.monitor_faults.buffer [i].a2 := xcb_p^.xp.a2_previous_save_area;
      xcb_p^.monitor_faults.present [i] := TRUE;
    ELSE
      IF broken_task = FALSE THEN
        broken_task := TRUE;
        fault_contents_p^.broken_task_condition := tmc$btc_mntr_fault_buffer_full;
        xcb_p^.xp.trap_enable := osc$traps_enabled;
      IFEND;
    IFEND;

    IF broken_task OR (monitor_fault_p^.identifier = tmc$broken_task_fault_id) THEN

      xcb_p^.system_error_count := xcb_p^.system_error_count + 1;

      IF xcb_p^.system_error_count > (tmv$system_error_hang_count + 4) THEN
        dpp$display_error ('Broken Task, System Error Count exceeds limit; Terminating System');
        halt_message (1, 10) := 'VEOS2020- ';
        halt_message (11, * ) := mtr_flt_message;
        mtp$step_unstep_system (syc$ic_fatal_software_error, halt_message);

      ELSEIF (xcb_p^.system_error_count = tmv$system_error_hang_count) OR (xcb_p^.monitor_faults.present [1])
            THEN

{  HUNG TASK

        IF (xcb_p^.system_table_lock_count >= 256) OR (xcb_p^.critical_task) THEN
          halt_message (1, 10) := 'VEOS2010- ';
          halt_message (11, * ) := mtr_flt_message;
          mtp$step_unstep_system (syc$ic_fatal_software_error, halt_message);
        ELSE
          IF tmv$halt_on_hung_task THEN
            mtv$scb.nos_180_status.system_status.step_status_block.requested_status := mtc$stepped_system;
            halt_message (1, 10) := 'VEOS9910- ';
            halt_message (11, * ) := mtr_flt_message;
            dpp$display_error ('Task hung, initiating software breakpoint');
            mtp$step_unstep_system (syc$ic_software_breakpoint, halt_message);
          IFEND;
          tmp$set_monitor_flag (xcb_p^.global_task_id, syc$mf_hang_task, status);
          mtf$cst_p () ^.ijle_p^.hung_task_in_job := TRUE;
        IFEND;

      IFEND;
    IFEND;

    IF broken_task AND (xcb_p^.monitor_faults.present [1] = FALSE) THEN
      xcb_p^.monitor_faults.buffer [1] := fault;
      xcb_p^.monitor_faults.present [1] := TRUE;
    IFEND;

    tmp$set_monitor_flag (xcb_p^.global_task_id, tmc$mf_cause_job_free_flag_trap, status);
    IF xcb_p^.xp.p_register.pva.ring <= tmv$system_debug_ring THEN
      IF (tmv$system_debug_segment = 0) OR (xcb_p^.xp.p_register.pva.seg <= tmv$system_debug_segment) THEN
        tmp$set_monitor_flag (xcb_p^.global_task_id, syc$mf_invoke_sysdebug, status);
      IFEND;
    ELSE
      IF tmv$job_debug_ring_p <> NIL THEN
        jdr_p := #ADDRESS (1, #SEGMENT (xcb_p), #OFFSET (tmv$job_debug_ring_p));
        IF xcb_p^.xp.p_register.pva.ring <= jdr_p^ THEN
          tmp$set_monitor_flag (xcb_p^.global_task_id, syc$mf_invoke_sysdebug, status);
        IFEND;
      IFEND;
    IFEND;

  PROCEND send_monitor_fault;
?? OLDTITLE ??
?? NEWTITLE := 'CHECK_REPAIR_TRAP_MECHANISM', EJECT ??

  PROCEDURE check_repair_trap_mechanism
    (    xcb_p: ^ost$execution_control_block;
         check_traps_enabled: boolean;
     VAR broken: boolean;
     VAR fault_id: tmt$broken_task_condition);

    VAR
      found: boolean,
      stack_segnum: ost$segment,
      stack_length: ost$segment_length,
      status: syt$monitor_status;

    broken := FALSE;


{  Make sure that traps are enabled.

    IF (check_traps_enabled = TRUE) AND (xcb_p^.xp.trap_enable <> osc$traps_enabled) THEN
      broken := TRUE;
      fault_id := tmc$btc_mf_traps_disabled;
      xcb_p^.xp.trap_enable := osc$traps_enabled;
    IFEND;


{Validate A0.

    mmp$fetch_stack_segment_info (xcb_p, xcb_p^.xp.p_register.pva.ring, { set_length_to_zero } FALSE,
          stack_segnum, stack_length, found);
    IF NOT found THEN
      mtp$error_stop ('BTC - lost the stack segment');
    IFEND;
    IF (#RING (xcb_p^.xp.a0_dynamic_space_pointer) <> xcb_p^.xp.p_register.pva.ring) OR
          (#SEGMENT (xcb_p^.xp.a0_dynamic_space_pointer) <> stack_segnum) OR
          (#OFFSET (xcb_p^.xp.a0_dynamic_space_pointer) < 0) OR
          (#OFFSET (xcb_p^.xp.a0_dynamic_space_pointer) + 37 * 8 > stack_length) THEN
      broken := TRUE;
      fault_id := tmc$btc_invalid_a0;
      xcb_p^.xp.a0_dynamic_space_pointer := #ADDRESS (xcb_p^.xp.p_register.pva.ring, stack_segnum,
            mmc$ring_crossing_offset);
      xcb_p^.xp.a2_previous_save_area := NIL;
      mmp$fetch_stack_segment_info (xcb_p, xcb_p^.xp.p_register.pva.ring, { set_length_to_zero } TRUE,
            stack_segnum, stack_length, found);
    IFEND;

  PROCEND check_repair_trap_mechanism;
?? OLDTITLE ??
MODEND tmm$mtr_flag_signal_functions;
