?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE: Program Control - Program Conditions' ??
MODULE pmm$dispose_of_conditions;

{   PURPOSE:
{     This module restricts the knowledge of disposing of conditions.
{     The module contains the procedures to dispose of all conditions.

{   DESIGN:
{     The procedures in this module are designed to have an execute
{     bracket of 2, 13 and a call bracket of 13.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_lexical
*copyc osc$space_unavailable_condition
*copyc osc$unseen_mail_condition
*copyc osc$volume_unavailable_cond
*copyc dbt$debug
*copyc osc$unseen_mail_condition
*copyc mmd$segment_access_condition
*copyc mme$condition_codes
*copyc osc$processor_defined_registers
*copyc osd$conditions
*copyc osd$registers
*copyc osd$virtual_address
*copyc oss$job_paged_literal
*copyc ost$name
*copyc ost$stack_frame_save_area
*copyc ost$status
*copyc ost$virtual_machine_identifier
*copyc pme$broken_condition_processor
*copyc pme$condition_exceptions
*copyc pmt$condition
*copyc pmt$condition_environment
*copyc pmt$condition_identifier
*copyc pmt$delayed_condition
*copyc pmt$established_handler_internl
*copyc pmt$ext_default_cond_handler
*copyc pmt$internal_condition
*copyc pmt$standard_selection
*copyc pmt$sys_default_cond_handler
?? POP ??
*copyc bap$find_open_file_via_segment
*copyc clp$default_unseen_mail_handler
*copyc clp$determine_when_condition
*copyc clp$get_fs_path_string
*copyc clp$process_when_cond_in_task
*copyc clp$validate_name
*copyc i#disable_traps
*copyc i#enable_traps
*copyc i#restore_traps
*copyc ifp$default_interactive_handler
*copyc ifp$fetch_context
*copyc jmp$begin_timesharing_handler
*copyc jmp$default_job_resource_hndlr
*copyc jmp$end_timesharing_handler
*copyc ofp$display_status_message
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$clear_wait_message
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$establish_condition_handler
*copyc osp$executing_in_job_monitor
*copyc osp$format_segment_condition
*copyc osp$format_system_condition
*copyc osp$generate_log_message
*copyc osp$generate_message
*copyc osp$get_current_display_message
*copyc osp$log_io_read_error
*copyc osp$recover_job
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc osp$set_status_from_condition
*copyc osp$system_error
*copyc pfp$get_file_info
*copyc pmp$abort
*copyc pmp$build_ring_crossing_frame
*copyc pmp$change_term_error_level
*copyc pmp$clear_pit_has_been_set
*copyc pmp$clear_pit_was_set_in_ch
*copyc pmp$debug_critical_frame
*copyc pmp$delete_current_environment
*copyc pmp$delete_environment
*copyc pmp$establish_condition_handler
*copyc pmp$exit
*copyc pmp$find_debug
*copyc pmp$find_handler_in_stack
*copyc pmp$find_handler_in_stack_frame
*copyc pmp$get_current_environment
*copyc pmp$get_delayed_condition
*copyc pmp$get_job_mode
*copyc pmp$get_mainframe_attributes
*copyc pmp$is_there_a_handler_in_stack
*copyc pmp$load
*copyc pmp$log
*copyc pmp$long_term_wait
*copyc pmp$pit_was_set
*copyc pmp$pit_was_set_in_ch
*copyc pmp$post_current_environment
*copyc pmp$post_delayed_condition
*copyc pmp$push_task_debug_mode
*copyc pmp$set_where_pit_can_be_cleard
*copyc pmp$task_debug_mode_on
*copyc pmp$task_debug_ring
*copyc pmp$task_state
*copyc pmp$terminate_popper
*copyc pmp$validate_previous_save_area
*copyc tmp$find_ring_crossing_frame

*copyc bav$task_file_table
*copyc bav$last_tft_entry
*copyc bav$tft_entry_assignment
*copyc pmv$task_execution_phase

{ The following two entry points bracket the vector simulator routine.

  VAR
    pma$vector_simulator: [XREF] cell,
    pma$vector_simulator_end: [XREF] cell;

?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??
?? NEWTITLE := 'condition selectors', EJECT ??


  VAR
    block_exit: [STATIC, READ, oss$job_paged_literal] pmt$condition :=
          [pmc$condition_combination, $pmt$condition_combination [pmc$block_exit_processing]],

{The following condition selector is named for the detection of software errors which are
{reflected as hardware conditions. However, included in the selector,
{implicitly via combination, is the hardware detected uncorrected error which is dealt with
{distinctly by the respective condition handler.

    condition_handler_faults: [STATIC, READ, oss$job_paged_literal] pmt$condition :=
          [pmc$condition_combination, $pmt$condition_combination
          [pmc$system_conditions, mmc$segment_access_condition]],

    environment_overwrite: [STATIC, READ, oss$job_paged_literal] pmt$condition :=
          [pmc$system_conditions, $pmt$system_conditions [pmc$access_violation, pmc$invalid_segment_ring_0,
          pmc$address_specification], * ],
    stack_read_error: [STATIC, READ, oss$job_paged_literal] pmt$condition :=
          [pmc$condition_combination, $pmt$condition_combination [mmc$segment_access_condition]];

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

{ PURPOSE:
{

  PROCEDURE default_system_cond_handler
    (    current_environment: ^pmt$condition_environment;
         inconsistent_stack: boolean);

    VAR
      executing_ring: ost$ring,
      status: ost$status;

    IF inconsistent_stack AND (pmv$task_execution_phase = pmc$task_popping_stack_frames) THEN
      osp$set_status_condition (pme$inconsistent_stack, status);
      pmp$terminate_popper (status); { Does not return
    IFEND;
    osp$format_system_condition (current_environment^.condition.system,
          current_environment^.condition.untranslatable_pointer, current_environment^.condition_save_area,
          status);

    CASE #RING (^executing_ring) OF
    = osc$tmtr_ring =
      IF (current_environment^.condition.system = pmc$detected_uncorrected_err) THEN
        pmp$exit (status);
      ELSE
        osp$system_error ('R2 system condition', ^status);
      IFEND;
    = osc$tsrv_ring .. osc$user_ring_4 =
      IF (current_environment^.condition.system = pmc$detected_uncorrected_err) THEN
        pmp$exit (status);
      ELSE
        pmp$abort (status);
      IFEND;
    CASEND;
  PROCEND default_system_cond_handler;
?? OLDTITLE ??
?? NEWTITLE := 'default_seg_access_cond_handler', EJECT ??

{ PURPOSE:
{

  PROCEDURE default_seg_access_cond_handler
    (    current_environment: ^pmt$condition_environment);

    TYPE
      segment_access_condition_set = set of pmt$condition_identifier;

    VAR
      executing_ring: ost$ring,
      fatal_segment_condition: boolean,
      job_monitor_task: boolean,
      status: ost$status,
      condition_status: ost$status;

    osp$format_segment_condition ('MM', current_environment^.condition.segment_access,
          current_environment^.condition_save_area, condition_status, status);
    IF NOT status.normal THEN
      osp$system_error ('undefined segment condition', ^status);
    IFEND;

    fatal_segment_condition := current_environment^.condition.segment_access.identifier IN
          -$segment_access_condition_set [mmc$sac_pf_space_limit_exceeded, mmc$sac_tf_space_limit_exceeded];
    job_monitor_task := osp$executing_in_job_monitor ();

    CASE #RING (^executing_ring) OF
    = osc$tmtr_ring =
      IF fatal_segment_condition THEN
        osp$system_error ('R2 segment access condition', ^condition_status);
      IFEND;
    = osc$tsrv_ring .. osc$user_ring_4 =
      IF fatal_segment_condition OR (NOT job_monitor_task) THEN
        IF job_monitor_task THEN
          pmp$exit (condition_status);
        ELSE
          pmp$abort (condition_status);
        IFEND;
      IFEND;
    ELSE
    CASEND;
  PROCEND default_seg_access_cond_handler;
?? OLDTITLE ??
?? NEWTITLE := 'post_ring_crossing_condition', EJECT ??

{ PURPOSE:
{

  PROCEDURE post_ring_crossing_condition
    (    trapped_sfsa: ^ost$stack_frame_save_area;
         condition_environment: ^pmt$condition_environment;
         below_ring: ost$valid_ring;
     VAR post_status: ost$status;
     VAR default_status: ost$status);

    VAR
      condition_processed: boolean,
      default_condition: pmt$condition,
      system_default_handler: ^pmt$sys_default_cond_handler,
      osv$job_recovery_required: [XREF] boolean,
      x_frame: ^ost$stack_frame_save_area,
      starting_frame: ^ost$stack_frame_save_area,
      ignore_status: ost$status,
      delay: pmt$delayed_condition;

?? NEWTITLE := 'perform_default_processing', EJECT ??

    PROCEDURE perform_default_processing
      (VAR default_status: ost$status);

      CONST
        screen_default_handler_name = 'CSP$DEFAULT_CONDITION_HANDLER  ';

      VAR
        callers_save_area: ^ost$stack_frame_save_area,
        external_default_handler: ^pmt$ext_default_cond_handler,
        ignore_term_error_level: ost$status_severity,
        interactive_context: array [1 .. 1] of ift$fetch_context_attribute,
        job_mode: jmt$job_mode,
        loaded_address: pmt$loaded_address,
        original_term_error_level: ost$status_severity;

?? NEWTITLE := 'abort_handler', EJECT ??

      PROCEDURE abort_handler
        (    condition: pmt$condition;
             ignore_info: ^pmt$condition_information;
             save_area: ^ost$stack_frame_save_area;
         VAR handler_status: ost$status);


        IF condition.selector = pmc$block_exit_processing THEN
          pmp$change_term_error_level (original_term_error_level, ignore_term_error_level, ignore_status);
          RETURN;
        IFEND;

        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);

      PROCEND abort_handler;
?? TITLE := 'invoke_condition_handler', EJECT ??

      PROCEDURE invoke_condition_handler
        (    condition: pmt$condition;
             condition_info: ^pmt$condition_information;
             save_area: ^ost$stack_frame_save_area;
         VAR handler_status: ost$status);

        CONST
          aborted_with = '* * *   CSP$DEFAULT_CONDITION_HANDLER aborted with...';

        VAR
          condition_status: ost$status;


        CASE condition.selector OF

        = pmc$system_conditions =
          IF (($pmt$system_conditions [pmc$instruction_specification, pmc$address_specification,
                pmc$access_violation, pmc$environment_specification, pmc$invalid_segment_ring_0,
                pmc$out_call_in_return] * condition.system_conditions) <> $pmt$system_conditions []) AND
                (save_area^.minimum_save_area.a2_previous_save_area = callers_save_area) THEN
          ELSE
            pmp$log (aborted_with, ignore_status);
            osp$set_status_from_condition (pmc$program_management_id, condition, save_area,
                  condition_status, ignore_status);
            osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], condition_status, ignore_status);
          IFEND;
          system_default_handler^ (default_condition, default_status);
          EXIT perform_default_processing;

        = mmc$segment_access_condition =
          pmp$log (aborted_with, ignore_status);
          osp$set_status_from_condition (pmc$program_management_id, condition, save_area,
                condition_status, ignore_status);
          osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], condition_status, ignore_status);
          system_default_handler^ (default_condition, default_status);
          EXIT perform_default_processing;

        = pmc$block_exit_processing =
          RETURN;

        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
        CASEND;

      PROCEND invoke_condition_handler;
?? OLDTITLE, EJECT ??

      default_status.normal := TRUE;

      job_mode := jmc$batch;
      pmp$get_job_mode (job_mode, ignore_status);
      IF job_mode = jmc$batch THEN

{ perform system default action if in a batch job

        system_default_handler^ (default_condition, default_status);
        RETURN;
      IFEND;

      interactive_context [1].key := ifc$previous_mode;
      interactive_context [1].previous_mode := ifc$line;
      ifp$fetch_context (interactive_context, ignore_status);
      IF interactive_context [1].previous_mode = ifc$line THEN

{ perform the system default action if currently in "line mode"

        system_default_handler^ (default_condition, default_status);
        RETURN;
      IFEND;

{ try to load the default handler for "screen mode"

      loaded_address.kind := pmc$procedure_address;
      loaded_address.pointer_to_procedure := NIL;
      original_term_error_level := osc$fatal_status;
      #SPOIL (original_term_error_level);
      osp$establish_block_exit_hndlr (^abort_handler);
      pmp$change_term_error_level (osc$fatal_status, original_term_error_level, default_status);
      IF default_status.normal THEN
        pmp$load (screen_default_handler_name, pmc$procedure_address, loaded_address, default_status);
        IF NOT default_status.normal THEN
          loaded_address.pointer_to_procedure := NIL;
        IFEND;
        pmp$change_term_error_level (original_term_error_level, ignore_term_error_level, default_status);
        osp$disestablish_cond_handler;
      IFEND;

      IF (NOT default_status.normal) OR (loaded_address.pointer_to_procedure = NIL) THEN

{ couldn't load the "screen mode" default handler so perform the system action

        default_status.normal := TRUE;
        system_default_handler^ (default_condition, default_status);
        RETURN;
      IFEND;

      #CONVERT_POINTER_TO_PROCEDURE (loaded_address.pointer_to_procedure, external_default_handler);

      callers_save_area := #PREVIOUS_SAVE_AREA ();
      #SPOIL (callers_save_area);
      osp$establish_condition_handler (^invoke_condition_handler, FALSE);

{ call (or at least try to call) the "screen mode" default handler

      external_default_handler^ (default_condition, system_default_handler, default_status);

      osp$disestablish_cond_handler;

    PROCEND perform_default_processing;
?? OLDTITLE ??
?? NEWTITLE := 'process_scl_condition', EJECT ??

    PROCEDURE process_scl_condition
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR condition_processed: boolean;
       VAR default_status: ost$status);

      VAR
        when_condition_definition: clt$when_condition_definition;


      clp$determine_when_condition (condition, condition_information, save_area, when_condition_definition,
            default_status);

      IF NOT default_status.normal THEN
        default_status.normal := TRUE;
        condition_processed := FALSE;
        RETURN;
      IFEND;

      clp$process_when_cond_in_task (when_condition_definition, ^perform_default_processing,
            condition_processed, default_status);

      default_status.normal := TRUE;

    PROCEND process_scl_condition;
?? OLDTITLE, EJECT ??

    post_status.normal := TRUE;
    default_status.normal := TRUE;
    x_frame := trapped_sfsa;
    starting_frame := trapped_sfsa;
    WHILE ((starting_frame <> NIL) AND (starting_frame^.minimum_save_area.a2_previous_save_area <> NIL) AND
          (#RING (starting_frame^.minimum_save_area.a2_previous_save_area) < below_ring) AND
          post_status.normal) DO
      tmp$find_ring_crossing_frame (starting_frame, x_frame, post_status);
      starting_frame := x_frame^.minimum_save_area.a2_previous_save_area;
    WHILEND;

    IF post_status.normal THEN
      IF (x_frame^.minimum_save_area.a2_previous_save_area <> NIL) THEN
        CASE condition_environment^.condition.class OF
        = pmc$system_conditions =
          delay.delayed_condition := debug;
          delay.condition := condition_environment^.condition;
          delay.condition_save_area := condition_environment^.condition_save_area^;
          delay.debug_index := condition_environment^.debug_index;

        = jmc$job_resource_condition =
          delay.delayed_condition := job_resource;
          delay.job_resource_condition := condition_environment^.condition.job_resource;

        = ifc$interactive_condition =
          jmp$begin_timesharing_handler (condition_environment^.condition.interactive);

{ is balanced by an end handler request in pmp$dispose_of_delayed_cond

          delay.delayed_condition := interactive;
          delay.interactive_condition := condition_environment^.condition.interactive;
        = pmc$pit_condition =
          delay.delayed_condition := process_interval_timer;
          pmp$set_where_pit_can_be_cleard;
        = pmc$user_defined_condition =
          delay.delayed_condition := user_condition;
          delay.user_defined := condition_environment^.condition.user_defined;
          delay.propagate_info := condition_environment^.condition.propagate_info;
          delay.condition_descriptor := condition_environment^.condition_descriptor;
          IF condition_environment^.condition.user_defined = 'OSC$JOB_RECOVERY' THEN
            IF osv$job_recovery_required THEN
              osp$recover_job;
            IFEND;
          IFEND;
        ELSE
          osp$set_status_abnormal (pmc$program_management_id, pme$broken_condition_processor,
                'invalid delayed system condition - PMM$DISPOSE_OF_CONDITIONS', post_status);
          osp$system_error ('invalid delayed system condition', ^post_status);
        CASEND;

        pmp$build_ring_crossing_frame (x_frame);
        pmp$post_delayed_condition (^delay, post_status);

      ELSE
        CASE condition_environment^.condition.class OF
        = jmc$job_resource_condition =
          default_condition.selector := jmc$job_resource_condition;
          default_condition.job_resource_condition := condition_environment^.condition.job_resource;
          system_default_handler := ^jmp$default_job_resource_hndlr;
          process_scl_condition (default_condition, condition_environment^.condition_descriptor,
                condition_environment^.condition_save_area, condition_processed, default_status);
          IF NOT (default_status.normal AND condition_processed) THEN
            default_status.normal := TRUE;
            perform_default_processing (default_status);
          IFEND;
        = ifc$interactive_condition =
          default_condition.selector := ifc$interactive_condition;
          default_condition.interactive_condition := condition_environment^.condition.interactive;
          system_default_handler := ^ifp$default_interactive_handler;
          process_scl_condition (default_condition, condition_environment^.condition_descriptor,
                condition_environment^.condition_save_area, condition_processed, default_status);
          IF NOT (default_status.normal AND condition_processed) THEN
            default_status.normal := TRUE;
            perform_default_processing (default_status);
          IFEND;
        = pmc$system_conditions =
          CASE condition_environment^.condition.system OF
          = pmc$debug_unselectable =
            osp$set_status_abnormal (pmc$program_management_id, pme$invalid_debug_trap,
                  'debug trap with no debugger loaded', default_status);
            pmp$exit (default_status);
          ELSE
            osp$set_status_abnormal (pmc$program_management_id, pme$broken_condition_processor,
                  'invalid delayed system condition - PMM$DISPOSE_OF_CONDITIONS', default_status);
            osp$system_error ('invalid delayed system condition', ^default_status);
          CASEND;
        = pmc$pit_condition =
          {there is no standard system procedure for a process interval timer condition} ;
          pmp$clear_pit_has_been_set;
        = pmc$user_defined_condition =
          IF condition_environment^.condition.user_defined = 'OSC$JOB_RECOVERY' THEN
            IF osv$job_recovery_required THEN
              osp$recover_job;
            IFEND;
          IFEND;
          default_condition.selector := pmc$user_defined_condition;
          default_condition.user_condition_name := condition_environment^.condition.user_defined;
          IF default_condition.user_condition_name = osc$unseen_mail_condition THEN
            system_default_handler := ^clp$default_unseen_mail_handler;
          ELSEIF condition_environment^.condition.propagate_info.call_default_handler THEN
            system_default_handler := ^default_user_defined_handler;
          ELSE
            system_default_handler := ^ignore_user_defined_condition;
          IFEND;
          IF NOT condition_environment^.condition.propagate_info.notify_scl THEN
            condition_processed := FALSE;
            default_status.normal := TRUE;
          ELSE
            process_scl_condition (default_condition, condition_environment^.condition_descriptor,
                  condition_environment^.condition_save_area, condition_processed, default_status);
          IFEND;
          IF NOT (default_status.normal AND condition_processed) THEN
            default_status.normal := TRUE;
            perform_default_processing (default_status);
          IFEND;
          default_status.normal := TRUE;
        ELSE
          osp$set_status_abnormal (pmc$program_management_id, pme$broken_condition_processor,
                'invalid delayed condition - PMM$DISPOSE_OF_CONDITIONS', default_status);
          osp$system_error ('invalid delayed condition', ^default_status);
        CASEND;
      IFEND;
    IFEND;
  PROCEND post_ring_crossing_condition;
?? OLDTITLE ??
?? NEWTITLE := 'set_debug_in_user_mask', EJECT ??

{ PURPOSE:
{

  PROCEDURE set_debug_in_user_mask;

    VAR
      sfsa: ^ost$stack_frame_save_area;

    IF pmp$task_debug_mode_on () THEN
      sfsa := #PREVIOUS_SAVE_AREA ();
      sfsa^.minimum_save_area.user_mask := sfsa^.minimum_save_area.user_mask + $ost$user_conditions
            [osc$debug];
    IFEND;
  PROCEND set_debug_in_user_mask;
?? OLDTITLE ??
?? NEWTITLE := 'clear_debug_in_user_mask', EJECT ??

{ PURPOSE:
{

  PROCEDURE clear_debug_in_user_mask;

    VAR
      sfsa: ^ost$stack_frame_save_area;

    sfsa := #PREVIOUS_SAVE_AREA ();
    sfsa^.minimum_save_area.user_mask := sfsa^.minimum_save_area.user_mask - $ost$user_conditions [osc$debug];
  PROCEND clear_debug_in_user_mask;
?? TITLE := '  determine_call_debug' ??
?? EJECT ??

  PROCEDURE determine_call_debug
    (VAR call_debug: boolean);

    VAR
      executing_ring: ost$ring,
      debug: dbt$debug;

    pmp$find_debug (debug);
    call_debug := (pmp$task_debug_mode_on () AND (#RING (^executing_ring) >= pmp$task_debug_ring ()) AND
          (debug <> NIL));
  PROCEND determine_call_debug;
?? OLDTITLE ??
?? OLDTITLE ??
?? NEWTITLE := 'dispose_condition_with_debugger', EJECT ??

{ PURPOSE:
{

  PROCEDURE dispose_condition_with_debugger
    (    current_environment: ^pmt$condition_environment;
         trapped_sfsa: ^ost$stack_frame_save_area;
         multiple_conditions: boolean);

    VAR
      debug: dbt$debug,
      debug_condition: pmt$condition,
      debug_status: ost$status,
      delete: ost$status,
      environment: pmt$condition_environment,
      ignore_status: ost$status,
      nonlocal_exit: pmt$established_handler,
      trap_enables: 0 .. 3;

?? NEWTITLE := 'dispose_of_nonlocal_exit', EJECT ??

{ PURPOSE:
{ This procedure (condition handler) ensures that the environment saved
{ before the debugger was called is deleted before a debugger's nonlocal
{ exit is permitted to complete.

    PROCEDURE dispose_of_nonlocal_exit
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);

      pmp$delete_environment (save_area, status);
      IF NOT status.normal THEN
        dispose_of_environment_overwrit (status);
      IFEND;
    PROCEND dispose_of_nonlocal_exit;
?? OLDTITLE, EJECT ??

    current_environment^.established_descriptor := NIL;
    current_environment^.handler_save_area := trapped_sfsa;
    environment := current_environment^;
    i#disable_traps (trap_enables);
    pmp$post_current_environment (^environment);
    pmp$establish_condition_handler (block_exit, ^dispose_of_nonlocal_exit, ^nonlocal_exit, ignore_status);
    i#enable_traps (trap_enables);
    debug_condition.selector := environment.condition.class;
    CASE environment.condition.class OF
    = pmc$system_conditions =
      debug_condition.system_conditions := $pmt$system_conditions [environment.condition.system];
      debug_condition.untranslatable_pointer := environment.condition.untranslatable_pointer;
    = pmc$block_exit_processing =
      debug_condition.reason := environment.condition.reason;
    = mmc$segment_access_condition =
      debug_condition.segment_access_condition := environment.condition.segment_access;
    = ifc$interactive_condition =
      debug_condition.interactive_condition := environment.condition.interactive;
    = jmc$job_resource_condition =
      debug_condition.job_resource_condition := environment.condition.job_resource;
    = pmc$pit_condition =
      ;
    = pmc$user_defined_condition =
      debug_condition.user_condition_name := environment.condition.user_defined;
    ELSE
    CASEND;

    debug_status.normal := TRUE;
    pmp$find_debug (debug);
    debug^ (debug_condition, environment.condition_descriptor, environment.condition_save_area, trapped_sfsa,
          environment.debug_index, multiple_conditions, debug_status);
    pmp$delete_current_environment (delete);
    #WRITE_REGISTER (osc$pr_clear_critical_frame, 0);
    IF NOT delete.normal THEN
      dispose_of_environment_overwrit (delete);
    IFEND;
    IF NOT debug_status.normal THEN
      pmp$push_task_debug_mode (pmc$debug_mode_off, ignore_status);
      pmp$exit (debug_status);
    IFEND;
  PROCEND dispose_condition_with_debugger;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_of_environment_overwrit', EJECT ??

{ PURPOSE:
{

  PROCEDURE dispose_of_environment_overwrit
    (VAR status {input, output} : ost$status);

    VAR
      executing_ring: ost$ring;

    CASE #RING (^executing_ring) OF
    = osc$os_ring_1 =
      osp$system_error ('R1 stack overwritten', ^status);
    = osc$tmtr_ring =
      osp$system_error ('R2 stack overwritten', ^status);
    = osc$tsrv_ring .. osc$user_ring_4 =
      osp$append_status_integer (osc$status_parameter_delimiter, #RING (^executing_ring), 10, FALSE, status);
      pmp$abort (status);
    CASEND;
  PROCEND dispose_of_environment_overwrit;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_of_descriptor_overwrit', EJECT ??

{ PURPOSE:
{

  PROCEDURE dispose_of_descriptor_overwrit
    (    condition: pmt$condition;
         condition_descriptor: ^pmt$condition_information;
         save_area: ^ost$stack_frame_save_area;
     VAR status: ost$status);

    osp$set_status_abnormal (pmc$program_management_id, pme$stack_overwritten, '', status);
    dispose_of_environment_overwrit (status);
  PROCEND dispose_of_descriptor_overwrit;
?? OLDTITLE ??
?? NEWTITLE := 'find_users_handler', EJECT ??

{ PURPOSE:
{

  PROCEDURE find_users_handler
    (    environment {input, output} : ^pmt$condition_environment;
     VAR handler_found: boolean;
     VAR status: ost$status);

?? NEWTITLE := 'dispose_of_stack_read_error', EJECT ??

{ PURPOSE:
{ This procedure (condition handler) ensures that segment access
{ conditions which may arise when scanning stack frames are reported.

    PROCEDURE dispose_of_stack_read_error
      (    segment_access_condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR ignore_status: ost$status);

      osp$set_status_from_condition (pmc$program_management_id, segment_access_condition, save_area, status,
            status);
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
      osp$set_status_abnormal (pmc$program_management_id, pme$inconsistent_stack, '', status);

      EXIT find_users_handler;

    PROCEND dispose_of_stack_read_error;
?? OLDTITLE, EJECT ??

    VAR
      read_error_descriptor: pmt$established_handler,
      ignore_status: ost$status;

    pmp$establish_condition_handler (stack_read_error, ^dispose_of_stack_read_error, ^read_error_descriptor,
          ignore_status);
    IF (environment^.condition.class = pmc$block_exit_processing) THEN
      pmp$find_handler_in_stack_frame (environment^.condition, environment^.condition_save_area,
            environment^.established_descriptor, environment^.handler_save_area, status);
    ELSE
      pmp$find_handler_in_stack (environment^.condition, environment^.condition_save_area,
            environment^.established_descriptor, environment^.handler_save_area, status);
    IFEND;

    IF status.normal THEN
      handler_found := (environment^.established_descriptor <> NIL);
    ELSE
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
    IFEND;
  PROCEND find_users_handler;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_pit_with_handler', EJECT ??

{ PURPOSE:
{

  PROCEDURE dispose_pit_with_handler
    (    current_environment {input, output} : ^pmt$condition_environment;
     VAR status: ost$status);


    VAR
      environment: pmt$condition_environment,
      handler_condition: pmt$condition,
      dispose_pit_psa: ^ost$stack_frame_save_area;

?? NEWTITLE := 'dispose_of_handler_faults', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that faults
{   occuring during the call to a user's condition handler
{   are reported.
{

    PROCEDURE dispose_of_handler_faults
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR fault_status: ost$status);


      VAR
        ignore_status: ost$status;

{ determine if call to the handler faulted or the handler itself faulted

      IF (save_area^.minimum_save_area.a2_previous_save_area <> dispose_pit_psa) THEN

{ call a user's handler if one is in effect

        pmp$continue_to_cause (pmc$execute_standard_procedure, fault_status);
      ELSE
        osp$set_status_from_condition (pmc$program_management_id, condition, save_area, status, status);
        IF (condition.selector <> pmc$system_conditions) OR
              ((condition.selector = pmc$system_conditions) AND
              NOT (pmc$detected_uncorrected_err IN condition.system_conditions)) THEN
          osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
          osp$set_status_from_condition (pmc$program_management_id, handler_condition,
                environment.condition_save_area, status, status);
          osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
          osp$set_status_abnormal (pmc$program_management_id, pme$invalid_condition_handler, 'pit conditions',
                status);
        IFEND;
        EXIT dispose_pit_with_handler;
      IFEND;
    PROCEND dispose_of_handler_faults;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_of_nonlocal_exit', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that the previous
{   pit condition environment is deleted before a user's
{   nonlocal exit completes.

    PROCEDURE dispose_of_nonlocal_exit
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);


      pmp$clear_pit_has_been_set;
      pmp$delete_environment (save_area, status);
      IF NOT status.normal THEN
        dispose_of_environment_overwrit (status);
      IFEND;
    PROCEND dispose_of_nonlocal_exit;
?? OLDTITLE, EJECT ??

    VAR
      fault_descriptor: pmt$established_handler,
      nonlocal_exit: pmt$established_handler,
      trap_enables: 0 .. 3,
      ignore_status: ost$status,
      delete: ost$status;

    dispose_pit_psa := #PREVIOUS_SAVE_AREA ();
    environment := current_environment^;
    handler_condition.selector := pmc$pit_condition;
    pmp$establish_condition_handler (condition_handler_faults, ^dispose_of_handler_faults, ^fault_descriptor,
          ignore_status);
    i#disable_traps (trap_enables);
    pmp$post_current_environment (^environment);
    pmp$establish_condition_handler (block_exit, ^dispose_of_nonlocal_exit, ^nonlocal_exit, ignore_status);
    i#enable_traps (trap_enables);

{call the user's condition handler

    set_debug_in_user_mask;
    environment.established_descriptor^.handler^ (handler_condition, NIL, environment.condition_save_area,
          status);
    clear_debug_in_user_mask;
    pmp$delete_current_environment (delete);
    #WRITE_REGISTER (osc$pr_clear_critical_frame, 0);
    IF NOT delete.normal THEN
      dispose_of_environment_overwrit (delete);
    IFEND;
  PROCEND dispose_pit_with_handler;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_pit_condition', EJECT ??

{ PURPOSE:
{

  PROCEDURE dispose_pit_condition
    (    sfsa: ^ost$stack_frame_save_area;
         multiple_conditions: boolean);


    VAR
      call_debug: boolean,
      executing_ring: ost$ring,
      status: ost$status,
      post_status: ost$status,
      users_handler_found: boolean,
      current_environment: pmt$condition_environment;

    status.normal := TRUE;
    IF pmp$pit_was_set () THEN
      current_environment.condition_save_area := sfsa;
      current_environment.condition.class := pmc$pit_condition;
      current_environment.condition_descriptor := NIL;
      current_environment.debug_index := 0;

      determine_call_debug (call_debug);
      IF NOT call_debug THEN
        find_users_handler (^current_environment, users_handler_found, status);
        IF status.normal THEN
          IF users_handler_found THEN
            pmp$clear_pit_was_set_in_ch;
            dispose_pit_with_handler (^current_environment, status);
            IF NOT pmp$pit_was_set_in_ch () THEN
              pmp$clear_pit_has_been_set;
            IFEND;
          ELSE
            post_ring_crossing_condition (sfsa, ^current_environment, (#RING (^executing_ring) + 1) MOD 16,
                  post_status, status);
            IF NOT post_status.normal THEN

{  Posting the process interval timer condition found an inconsistent stack segment - the pit
{  condition will be ignored and continued execution of the task will detect the inconsistent
{  stack again, at which time the task will be aborted.

              status.normal := TRUE;
              pmp$clear_pit_has_been_set;
            IFEND;
          IFEND;
        ELSE

{finding user's handler found an inconsistent stack segment or handler stack - the pit condition
{will be ignored and continued execution of the task will detect the inconsistent stack again, at
{which time the task will be aborted.

          status.normal := TRUE;
          pmp$clear_pit_has_been_set;
        IFEND;
      ELSE
        pmp$clear_pit_was_set_in_ch;
        dispose_condition_with_debugger (^current_environment, sfsa, multiple_conditions);
        IF NOT pmp$pit_was_set_in_ch () THEN
          pmp$clear_pit_has_been_set;
        IFEND;
      IFEND;
      IF NOT status.normal THEN
        pmp$exit (status);
      IFEND;
    IFEND;
  PROCEND dispose_pit_condition;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_block_exit_with_handler', EJECT ??

{ PURPOSE:
{

  PROCEDURE dispose_block_exit_with_handler
    (    current_environment {input,output} : ^pmt$condition_environment;
     VAR status: ost$status);


    VAR
      environment: pmt$condition_environment,
      handler_condition: pmt$condition,
      dispose_block_exit_psa: ^ost$stack_frame_save_area;

?? NEWTITLE := 'dispose_of_handler_faults', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that faults
{   occuring during the call to a user's condition handler
{   are reported.

    PROCEDURE dispose_of_handler_faults
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR fault_status: ost$status);

      VAR
        ignore_status: ost$status;

{determine if call to the handler faulted or the handler itself faulted

      IF (save_area^.minimum_save_area.a2_previous_save_area <> dispose_block_exit_psa) THEN

{call a user's handler if one is in effect

        pmp$continue_to_cause (pmc$execute_standard_procedure, fault_status);
      ELSE
        osp$set_status_from_condition (pmc$program_management_id, condition, save_area, status, status);
        IF (condition.selector <> pmc$system_conditions) OR
              ((condition.selector = pmc$system_conditions) AND
              NOT (pmc$detected_uncorrected_err IN condition.system_conditions)) THEN
          osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
          osp$set_status_from_condition (pmc$program_management_id, handler_condition,
                environment.condition_save_area, status, status);
          osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
          osp$set_status_abnormal (pmc$program_management_id, pme$invalid_condition_handler, 'block exits',
                status);
        IFEND;
        EXIT dispose_block_exit_with_handler;
      IFEND;
    PROCEND dispose_of_handler_faults;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_of_nonlocal_exit', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that the previous
{   block exit condition environment is deleted before a nonlocal
{   exit completes.

    PROCEDURE dispose_of_nonlocal_exit
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);


      pmp$delete_environment (save_area, status);
      IF NOT status.normal THEN
        dispose_of_environment_overwrit (status);
      IFEND;
    PROCEND dispose_of_nonlocal_exit;
?? OLDTITLE, EJECT ??

    VAR
      fault_descriptor: pmt$established_handler,
      nonlocal_exit: pmt$established_handler,
      trap_enables: 0 .. 3,
      ignore_status: ost$status,
      delete: ost$status;

    dispose_block_exit_psa := #PREVIOUS_SAVE_AREA ();
    environment := current_environment^;
    handler_condition.selector := pmc$block_exit_processing;
    handler_condition.reason := environment.condition.reason;
    pmp$establish_condition_handler (condition_handler_faults, ^dispose_of_handler_faults, ^fault_descriptor,
          ignore_status);
    i#disable_traps (trap_enables);
    pmp$post_current_environment (^environment);
    pmp$establish_condition_handler (block_exit, ^dispose_of_nonlocal_exit, ^nonlocal_exit, ignore_status);
    i#enable_traps (trap_enables);

{call the user's condition handler

    set_debug_in_user_mask;
    environment.established_descriptor^.handler^ (handler_condition, environment.condition_descriptor,
          environment.condition_save_area, status);
    clear_debug_in_user_mask;
    pmp$delete_current_environment (delete);
    #WRITE_REGISTER (osc$pr_clear_critical_frame, 0);
    IF NOT delete.normal THEN
      dispose_of_environment_overwrit (delete);
    IFEND;
  PROCEND dispose_block_exit_with_handler;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_of_block_exit_cond', EJECT ??

{ PURPOSE:
{

  PROCEDURE dispose_of_block_exit_cond
    (    condition_save_area: ^ost$stack_frame_save_area);


    VAR
      status: ost$status,
      task_state: pmt$task_state,
      debug_critical_frame: boolean,
      call_debug: boolean,
      users_handler_found: boolean,
      current_environment: pmt$condition_environment;

    status.normal := TRUE;
    current_environment.condition.class := pmc$block_exit_processing;
    current_environment.condition_save_area := condition_save_area;
    current_environment.condition_descriptor := NIL;
    current_environment.debug_index := 0;
    task_state := pmp$task_state ();
    CASE task_state OF
    = pmc$task_active =
      current_environment.condition.reason := $pmt$block_exit_reason [pmc$block_exit];
    = pmc$program_exiting, pmc$debug_ending, pmc$task_terminating =
      current_environment.condition.reason := $pmt$block_exit_reason [pmc$program_termination];
    = pmc$program_aborting =
      current_environment.condition.reason := $pmt$block_exit_reason [pmc$program_abort];
    CASEND;
    determine_call_debug (call_debug);
    IF call_debug THEN
      pmp$debug_critical_frame (condition_save_area, debug_critical_frame);
    IFEND;
    IF NOT (call_debug AND debug_critical_frame) THEN
      find_users_handler (^current_environment, users_handler_found, status);
      IF status.normal AND users_handler_found THEN
        dispose_block_exit_with_handler (^current_environment, status);
      ELSEIF NOT status.normal THEN
        pmp$abort (status);
      IFEND;
    ELSE
      dispose_condition_with_debugger (^current_environment, condition_save_area, FALSE);
      find_users_handler (^current_environment, users_handler_found, status);
      IF status.normal AND users_handler_found THEN
        dispose_block_exit_with_handler (^current_environment, status);
      ELSEIF NOT status.normal THEN
        pmp$abort (status);
      IFEND;
    IFEND;
    IF NOT status.normal THEN
      pmp$exit (status);
    IFEND;
  PROCEND dispose_of_block_exit_cond;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_system_with_handler', EJECT ??

{ PURPOSE:
{

  PROCEDURE dispose_system_with_handler
    (    current_environment {input,output} : ^pmt$condition_environment;
     VAR status: ost$status);


    VAR
      environment: pmt$condition_environment,
      handler_condition: pmt$condition,
      dispose_system_psa: ^ost$stack_frame_save_area;


?? NEWTITLE := 'dispose_of_handler_faults', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that faults
{   occuring during the call to a user's condition handler
{   are reported.

    PROCEDURE dispose_of_handler_faults
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR fault_status: ost$status);


      VAR
        ignore_status: ost$status;

{determine if call to the handler faulted or the handler itself faulted

      IF (save_area^.minimum_save_area.a2_previous_save_area <> dispose_system_psa) THEN

{call a user's handler if one is in effect

        pmp$continue_to_cause (pmc$execute_standard_procedure, fault_status);
      ELSE
        osp$set_status_from_condition (pmc$program_management_id, condition, save_area, status, status);
        IF (condition.selector <> pmc$system_conditions) OR
              ((condition.selector = pmc$system_conditions) AND
              NOT (pmc$detected_uncorrected_err IN condition.system_conditions)) THEN
          osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
          osp$set_status_from_condition (pmc$program_management_id, handler_condition,
                environment.condition_save_area, status, status);
          osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
          osp$set_status_abnormal (pmc$program_management_id, pme$invalid_condition_handler,
                'system conditions', status);
        IFEND;
        EXIT dispose_system_with_handler;
      IFEND;
    PROCEND dispose_of_handler_faults;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_of_nonlocal_exit', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that the system
{   condition environment associated with the save_area is
{   deleted and the user's condition handler is set inactive for
{   the condition before a user's nonlocal exit completes.
{ NOTE:
{   The environment may not have been overwritten to the extent that
{   pmp$delete_environment detected an error, but portions (i.e.,
{   established_descriptor^) may have been overwritten causing a
{   fault when setting the handler inactive.  An occuring fault will
{   be routed to dispose_of_descriptor_overwrit which will abort
{   task or call system error.

    PROCEDURE dispose_of_nonlocal_exit
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);

      VAR
        executing_stack_segment: ost$segment,
        ignore_status: ost$status,
        internal_descriptor_p: ^pmt$established_handler_internl,
        overwrite_descriptor: pmt$established_handler;

      pmp$delete_environment (save_area, status);
      IF status.normal THEN
        pmp$establish_condition_handler (environment_overwrite, ^dispose_of_descriptor_overwrit,
              ^overwrite_descriptor, ignore_status);
        internal_descriptor_p := #LOC (environment.established_descriptor^);
        IF (#SEGMENT (environment.established_descriptor) = #SEGMENT (^executing_stack_segment)) OR
              internal_descriptor_p^.established_outside_block THEN

{clear handler active for the condition

          environment.established_descriptor^.handler_active.system :=
                (environment.established_descriptor^.handler_active.system XOR
                $pmt$system_conditions [environment.condition.system]);
        ELSE
          osp$set_status_abnormal (pmc$program_management_id, pme$stack_overwritten, '', status);
          dispose_of_environment_overwrit (status);
        IFEND;
      ELSE
        dispose_of_environment_overwrit (status);
      IFEND;
    PROCEND dispose_of_nonlocal_exit;
?? OLDTITLE, EJECT ??

    VAR
      delete: ost$status,
      executing_stack_segment: ost$segment,
      fault_descriptor: pmt$established_handler,
      ignore_status: ost$status,
      internal_descriptor_p: ^pmt$established_handler_internl,
      nonlocal_exit: pmt$established_handler,
      overwrite_descriptor: pmt$established_handler,
      trap_enables: 0 .. 3;

    dispose_system_psa := #PREVIOUS_SAVE_AREA ();
    environment := current_environment^;
    IF NOT (environment.condition.system IN environment.established_descriptor^.handler_active.system) THEN
      handler_condition.selector := pmc$system_conditions;
      handler_condition.system_conditions := $pmt$system_conditions [environment.condition.system];
      handler_condition.untranslatable_pointer := environment.condition.untranslatable_pointer;

{set handler active for the condition

      environment.established_descriptor^.handler_active.system :=
            (environment.established_descriptor^.handler_active.system XOR $pmt$system_conditions
            [environment.condition.system]);
      pmp$establish_condition_handler (condition_handler_faults, ^dispose_of_handler_faults,
            ^fault_descriptor, ignore_status);
      i#disable_traps (trap_enables);
      pmp$post_current_environment (^environment);
      pmp$establish_condition_handler (block_exit, ^dispose_of_nonlocal_exit, ^nonlocal_exit, ignore_status);
      i#enable_traps (trap_enables);

{call the user's condition handler

      set_debug_in_user_mask;
      environment.established_descriptor^.handler^ (handler_condition, environment.condition_descriptor,
            environment.condition_save_area, status);
      clear_debug_in_user_mask;
      pmp$delete_current_environment (delete);
      #WRITE_REGISTER (osc$pr_clear_critical_frame, 0);
      IF delete.normal THEN

{        NOTE:
{          The environment may not have been overwritten to the extent that
{          pmp$delete_current_environment detected an error, but portions
{          (i.e., established_descriptor^) may have been overwritten causing a
{          fault when setting the handler inactive.  An occuring fault will
{          be routed to dispose_of_descriptor_overwrit which will abort
{          task or call system error.

        pmp$establish_condition_handler (environment_overwrite, ^dispose_of_descriptor_overwrit,
              ^overwrite_descriptor, ignore_status);
        internal_descriptor_p := #LOC (environment.established_descriptor^);
        IF (#SEGMENT (environment.established_descriptor) = #SEGMENT (^executing_stack_segment)) OR
              internal_descriptor_p^.established_outside_block THEN

{clear handler active for the condition

          environment.established_descriptor^.handler_active.system :=
                (environment.established_descriptor^.handler_active.system XOR
                $pmt$system_conditions [environment.condition.system]);
        ELSE
          osp$set_status_abnormal (pmc$program_management_id, pme$stack_overwritten, '', delete);
          dispose_of_environment_overwrit (delete);
        IFEND;
      ELSE
        dispose_of_environment_overwrit (delete);
      IFEND;
    ELSE
      osp$set_status_abnormal (pmc$program_management_id, pme$condition_in_handler, 'system condition',
            status);
    IFEND;
  PROCEND dispose_system_with_handler;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] pmp$dispose_ucr_conditions', EJECT ??
*copyc pmh$dispose_ucr_conditions

  PROCEDURE [XDCL] pmp$dispose_ucr_conditions
    (VAR outstanding_ucr {input, output} : ost$user_conditions;
         condition_save_area: ^ost$stack_frame_save_area;
         debug_index: 0 .. 31);

    CONST
      five_minutes = 300000;

    TYPE
      op_code = 0 .. 0ff(16);

    VAR
      call_debug: boolean,
      current_environment: pmt$condition_environment,
      op_code_pointer: ^op_code,
      original_display_message: oft$display_message,
      p_address: ^cell,
      status: ost$status,
      system_condition: pmt$system_condition,
      ucr_condition: ost$user_condition,
      users_handler_found: boolean,
      vector_attribute: array [1 .. 1] of pmt$mainframe_attribute,
      wait_message_displayed: boolean;

    VAR
      maskable_system_conditions: [STATIC, READ, oss$job_paged_literal] pmt$system_conditions :=
            $pmt$system_conditions [pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
            pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite, pmc$arithmetic_significance,
            pmc$invalid_bdp_data];

    status.normal := TRUE;
    current_environment.condition.class := pmc$system_conditions;
    current_environment.condition_save_area := condition_save_area;
    current_environment.debug_index := debug_index;
    current_environment.condition_descriptor := NIL;

{If debug is set, clear all other UCR exceptions except debug and critical frame. If anyother exceptions
{were present, the eliminated exception(s) will arise at the attempt to re-execute the instruction.

    IF (osc$debug IN outstanding_ucr) THEN
      outstanding_ucr := (outstanding_ucr * $ost$user_conditions [osc$critical_frame_flag, osc$debug]);

{The following prioritizes invalid bdp data and the other arithmetic UCR exceptions, eliminating
{potentially invalid exceptions. If any valid exceptions were present, the eliminated exception(s) will
{arise at the attempt to re-execute the instruction.

    ELSEIF (osc$invalid_bdp_data IN outstanding_ucr) THEN
      outstanding_ucr := (outstanding_ucr * $ost$user_conditions
            [osc$critical_frame_flag, osc$invalid_bdp_data]);
    IFEND;
    ucr_condition := osc$privileged_instruction;
    system_condition := pmc$privileged_instruction;
    REPEAT
      IF (ucr_condition IN outstanding_ucr) THEN
        outstanding_ucr := (outstanding_ucr XOR $ost$user_conditions [ucr_condition]);
        current_environment.condition.system := system_condition;
        IF (system_condition = pmc$unimplemented_instruction) THEN

          p_address := #ADDRESS (condition_save_area^.minimum_save_area.p_register.pva.ring,
                condition_save_area^.minimum_save_area.p_register.pva.seg,
                condition_save_area^.minimum_save_area.p_register.pva.offset);
          op_code_pointer := p_address;
          IF (op_code_pointer^ >= 40(16)) AND (op_code_pointer^ <= 5E(16)) THEN
            vector_attribute [1].key := pmc$mak_vector_simulation;
            pmp$get_mainframe_attributes (vector_attribute, {ignore} status);
            WHILE vector_attribute [1].vector_simulation = pmc$vectors_suspended DO
              osp$get_current_display_message (original_display_message);
              ofp$display_status_message (' Waiting for vector processing.', status);
              wait_message_displayed := TRUE;
              pmp$long_term_wait (five_minutes, five_minutes);
              osp$clear_wait_message (original_display_message, wait_message_displayed);
              pmp$get_mainframe_attributes (vector_attribute, {ignore} status);
            WHILEND;
            IF vector_attribute [1].vector_simulation = pmc$vectors_simulated THEN
              RETURN;
            IFEND;
          IFEND;
        IFEND;
        IF (system_condition = pmc$cff_unselectable) THEN
          dispose_of_block_exit_cond (condition_save_area);
        ELSEIF (system_condition = pmc$pit_unselectable) THEN
          dispose_pit_condition (condition_save_area, FALSE);
        ELSE
          determine_call_debug (call_debug);
          IF NOT call_debug THEN
            IF (system_condition <> pmc$debug_unselectable) THEN
              find_users_handler (^current_environment, users_handler_found, status);
              IF status.normal AND users_handler_found THEN
                dispose_system_with_handler (^current_environment, status);
              ELSE

{The program being executed may have inhibited any of the maskable system conditions, caused
{one of the inhibited conditions, and returned to the original caller. Because in general all
{maskable system conditions are enabled in the original caller, the condition will arise when
{the original caller is returned to. Therefore, if the condition is a maskable system
{condition and the stack frame belongs to the original caller (i.e., the frame's previous save
{area pointer = NIL), the condition is ignored.

                IF NOT ((current_environment.condition.system IN maskable_system_conditions) AND
                      (current_environment.condition_save_area^.minimum_save_area.a2_previous_save_area =
                      NIL)) THEN
                  default_system_cond_handler (^current_environment, { inconsistand_stack } FALSE);
                IFEND;
              IFEND;
            ELSEIF pmp$task_debug_mode_on () THEN
              post_ring_crossing_condition (condition_save_area, ^current_environment, pmp$task_debug_ring (),
                    status, status);
              IF NOT status.normal THEN

{posting the debug condition found an inconsistent stack segment - the debug condition will be
{ignored and continued execution of the task will detect the inconsistent stack again, at
{which time the task will be aborted.

                status.normal := TRUE;
              IFEND;
            IFEND;
          ELSE
            dispose_condition_with_debugger (^current_environment, condition_save_area, FALSE);
          IFEND;
        IFEND;
      IFEND;
      IF (ucr_condition < osc$invalid_bdp_data) THEN
        ucr_condition := SUCC (ucr_condition);
        system_condition := SUCC (system_condition);
      IFEND;
    UNTIL (outstanding_ucr = $ost$user_conditions []) OR NOT status.normal;
    IF NOT status.normal THEN
      pmp$exit (status);
    IFEND;
  PROCEND pmp$dispose_ucr_conditions;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] pmp$dispose_mcr_conditions', EJECT ??
*copyc pmh$dispose_mcr_conditions

*copyc ost$monitor_fault

  PROCEDURE [XDCL] pmp$dispose_mcr_conditions
    (    fault: ost$monitor_fault;
         sfsa: ^ost$stack_frame_save_area);

?? NEWTITLE := 'dispose_of_mcr_conditions', EJECT ??

{ PURPOSE:
{

    PROCEDURE dispose_of_mcr_conditions
      (    sfsa: ^ost$stack_frame_save_area;
           untranslatable_pointer: ost$pva;
           mcr_conditions: pmt$system_conditions;
       VAR status: ost$status);

      VAR
        call_debug: boolean,
        users_handler_found: boolean,
        current_environment: pmt$condition_environment,
        mcr_condition: pmt$system_condition;

      status.normal := TRUE;
      current_environment.condition.class := pmc$system_conditions;
      current_environment.condition.untranslatable_pointer := untranslatable_pointer;
      current_environment.condition_save_area := sfsa;
      current_environment.condition_descriptor := NIL;
      current_environment.debug_index := 0;

{The following conditional statement prioritizes multiple MCR interrupts.

      IF (pmc$detected_uncorrected_err IN mcr_conditions) THEN
        mcr_condition := pmc$detected_uncorrected_err;

{The following conditional statement prioritizes multiple MCR group 3 interrupts eliminating
{potentially invalid exceptions. If the exception is corrected and anyother exception which may have
{present was valid, the exception will arise at the attempt to re-execute the instruction.

      ELSEIF (pmc$instruction_specification IN mcr_conditions) THEN
        mcr_condition := pmc$instruction_specification;

{The following conditional statments (invalid_segment .. address_spec) prioritizes the exceptions
{which require the UTP to be updated, eliminating all other exceptions. If the exception is corrected
{and anyother exception which may have present was valid, the exception will arise at the attempt to
{re-execute the instruction.

      ELSEIF (pmc$invalid_segment_ring_0 IN mcr_conditions) THEN
        mcr_condition := pmc$invalid_segment_ring_0;
      ELSEIF (pmc$access_violation IN mcr_conditions) THEN
        mcr_condition := pmc$access_violation;
      ELSEIF (pmc$address_specification IN mcr_conditions) THEN
        mcr_condition := pmc$address_specification;
      ELSE
        mcr_condition := pmc$ua_unselectable;
        WHILE NOT (mcr_condition IN mcr_conditions) DO
          IF (mcr_condition < pmc$out_call_in_return) THEN
            mcr_condition := SUCC (mcr_condition);
          IFEND;
        WHILEND;
      IFEND;

{ If the fault occurred within the vector simulation code then make it look
{ like it occurred on the vector instruction itself.

      current_environment.condition.system := mcr_condition;
      IF (sfsa^.minimum_save_area.p_register.pva.seg = #SEGMENT (^pma$vector_simulator)) AND
            (sfsa^.minimum_save_area.p_register.pva.offset >= #OFFSET (^pma$vector_simulator)) AND
            (sfsa^.minimum_save_area.p_register.pva.offset <= #OFFSET (^pma$vector_simulator_end)) THEN
        current_environment.condition_save_area := sfsa^.minimum_save_area.a2_previous_save_area;
      IFEND;

      determine_call_debug (call_debug);
      IF NOT call_debug THEN
        find_users_handler (^current_environment, users_handler_found, status);
        IF status.normal AND users_handler_found THEN
          dispose_system_with_handler (^current_environment, status);
        ELSE
          default_system_cond_handler (^current_environment, { inconsistent_stack } status.condition =
                pme$inconsistent_stack);
        IFEND;
      ELSE
        dispose_condition_with_debugger (^current_environment, sfsa, FALSE);
      IFEND;
    PROCEND dispose_of_mcr_conditions;
?? OLDTITLE, EJECT ??

*copyc tmt$mcr_faults

    VAR
      mcr_faults: ^tmt$mcr_faults,
      monitor_condition: ost$monitor_condition,
      monitor_conditions: ost$monitor_conditions,
      system_condition: pmt$system_condition,
      selectable_mcr_conditions: ost$monitor_conditions,
      untranslatable_pointer: ost$pva,
      mcr_conditions: pmt$system_conditions,
      status: ost$status;

    status.normal := TRUE;
    mcr_faults := #LOC (fault.contents);
    selectable_mcr_conditions := $ost$monitor_conditions [osc$detected_uncorrected_err, osc$instruction_spec,
          osc$address_specification, osc$access_violation, osc$invalid_segment_ring_0, osc$out_call_in_return,
          osc$environment_spec];
    monitor_conditions := (mcr_faults^.faults * selectable_mcr_conditions);
    IF (monitor_conditions <> $ost$monitor_conditions []) THEN
      untranslatable_pointer := mcr_faults^.untranslatable_pointer;
      system_condition := pmc$detected_uncorrected_err;
      mcr_conditions := $pmt$system_conditions [];
      FOR monitor_condition := osc$detected_uncorrected_err TO osc$trap_exception DO
        IF (monitor_condition IN monitor_conditions) THEN
          mcr_conditions := (mcr_conditions + $pmt$system_conditions [system_condition]);
        IFEND;
        IF (monitor_condition < osc$trap_exception) THEN
          system_condition := SUCC (system_condition);
        IFEND;
      FOREND;
      dispose_of_mcr_conditions (sfsa, untranslatable_pointer, mcr_conditions, status);
      IF NOT status.normal THEN
        pmp$exit (status);
      IFEND;
    IFEND;
  PROCEND pmp$dispose_mcr_conditions;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_seg_access_with_handler', EJECT ??

{ PURPOSE:
{

  PROCEDURE dispose_seg_access_with_handler
    (    current_environment {input, output} : ^pmt$condition_environment;
     VAR status: ost$status);


    VAR
      environment: pmt$condition_environment,
      handler_condition: pmt$condition,
      dispose_segment_psa: ^ost$stack_frame_save_area;

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

{ PURPOSE:
{   This procedure (condition handler) ensures that faults
{   occuring during the call to a user's condition handler are
{   reported.

    PROCEDURE dispose_of_handler_faults
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR fault_status: ost$status);


      VAR
        ignore_status: ost$status;

{determine if call to the handler faulted or the handler itself faulted

      IF (save_area^.minimum_save_area.a2_previous_save_area <> dispose_segment_psa) THEN

{call a user's handler if one is in effect

        pmp$continue_to_cause (pmc$execute_standard_procedure, fault_status);
      ELSE
        osp$set_status_from_condition (pmc$program_management_id, condition, save_area, status, status);
        IF (condition.selector <> pmc$system_conditions) OR
              ((condition.selector = pmc$system_conditions) AND
              NOT (pmc$detected_uncorrected_err IN condition.system_conditions)) THEN
          osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
          osp$set_status_from_condition (pmc$program_management_id, handler_condition,
                environment.condition_save_area, status, status);
          osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
          osp$set_status_abnormal (pmc$program_management_id, pme$invalid_condition_handler,
                'segment access conditions', status);
        IFEND;
        EXIT dispose_seg_access_with_handler;
      IFEND;
    PROCEND dispose_of_handler_faults;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_of_nonlocal_exit', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that the system
{   condition environment associated with the save_area is
{   deleted and the user's condition handler is set inactive for
{   the condition before a user's nonlocal exit completes.
{ NOTE:
{   The environment may not have been overwritten to the extent that
{   pmp$delete_environment detected an error, but portions (i.e.,
{   established_descriptor^) may have been overwritten causing a
{   fault when setting the handler inactive.  An occuring fault will
{   be routed to dispose_of_descriptor_overwrit which will abort
{   task or call system error.
{

    PROCEDURE dispose_of_nonlocal_exit
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);


      VAR
        executing_stack_segment: ost$segment,
        ignore_status: ost$status,
        internal_descriptor_p: ^pmt$established_handler_internl,
        overwrite_descriptor: pmt$established_handler;

      pmp$delete_environment (save_area, status);
      IF status.normal THEN
        pmp$establish_condition_handler (environment_overwrite, ^dispose_of_descriptor_overwrit,
              ^overwrite_descriptor, ignore_status);
        internal_descriptor_p := #LOC (environment.established_descriptor^);
        IF (#SEGMENT (environment.established_descriptor) = #SEGMENT (^executing_stack_segment)) OR
              internal_descriptor_p^.established_outside_block THEN

{clear handler active for the condition

          environment.established_descriptor^.handler_active.segment_access.identifier := 0;
          environment.established_descriptor^.handler_active.segment_access.segment := NIL;
        ELSE
          osp$set_status_abnormal (pmc$program_management_id, pme$stack_overwritten, '', status);
          dispose_of_environment_overwrit (status);
        IFEND;
      ELSE
        dispose_of_environment_overwrit (status);
      IFEND;
    PROCEND dispose_of_nonlocal_exit;
?? OLDTITLE, EJECT ??

    VAR
      active_segment: ost$segment,
      condition_segment: ost$segment,
      delete: ost$status,
      executing_stack_segment: ost$segment,
      fault_descriptor: pmt$established_handler,
      ignore_status: ost$status,
      internal_descriptor_p: ^pmt$established_handler_internl,
      nonlocal_exit: pmt$established_handler,
      overwrite_descriptor: pmt$established_handler,
      trap_enables: 0 .. 3;

    dispose_segment_psa := #PREVIOUS_SAVE_AREA ();
    environment := current_environment^;
    active_segment := #SEGMENT (environment.established_descriptor^.handler_active.segment_access.segment);
    condition_segment := #SEGMENT (environment.condition.segment_access.segment);
    IF (environment.condition.segment_access.identifier <>
          environment.established_descriptor^.handler_active.segment_access.identifier) AND
          ((environment.established_descriptor^.handler_active.segment_access.segment = NIL) OR
          (condition_segment <> active_segment)) THEN
      handler_condition.selector := mmc$segment_access_condition;
      handler_condition.segment_access_condition := environment.condition.segment_access;

{set handler active for condition

      environment.established_descriptor^.handler_active.segment_access :=
            environment.condition.segment_access;
      pmp$establish_condition_handler (condition_handler_faults, ^dispose_of_handler_faults,
            ^fault_descriptor, ignore_status);
      i#disable_traps (trap_enables);
      pmp$establish_condition_handler (block_exit, ^dispose_of_nonlocal_exit, ^nonlocal_exit, ignore_status);
      pmp$post_current_environment (^environment);
      i#enable_traps (trap_enables);

{call the user' condition handler

      set_debug_in_user_mask;
      environment.established_descriptor^.handler^ (handler_condition, environment.condition_descriptor,
            environment.condition_save_area, status);
      clear_debug_in_user_mask;
      pmp$delete_current_environment (delete);
      #WRITE_REGISTER (osc$pr_clear_critical_frame, 0);
      IF delete.normal THEN

{        NOTE:
{          The environment may not have been overwritten to the extent that
{          pmp$delete_current_environment detected an error, but portions
{          (i.e., established_descriptor^) may have been overwritten causing a
{          fault when setting the handler inactive.  An occuring fault will
{          be routed to dispose_of_descriptor_overwrit which will abort
{          task or call system error.

        pmp$establish_condition_handler (environment_overwrite, ^dispose_of_descriptor_overwrit,
              ^overwrite_descriptor, ignore_status);
        internal_descriptor_p := #LOC (environment.established_descriptor^);
        IF (#SEGMENT (environment.established_descriptor) = #SEGMENT (^executing_stack_segment)) OR
              internal_descriptor_p^.established_outside_block THEN

{clear handler active for the condition

          environment.established_descriptor^.handler_active.segment_access.identifier := 0;
          environment.established_descriptor^.handler_active.segment_access.segment := NIL;
        ELSE
          osp$set_status_abnormal (pmc$program_management_id, pme$stack_overwritten, '', delete);
          dispose_of_environment_overwrit (delete);
        IFEND;
      ELSE
        dispose_of_environment_overwrit (delete);
      IFEND;
    ELSE
      osp$set_status_abnormal (pmc$program_management_id, pme$condition_in_handler,
            'segment access condition', status);
    IFEND;

  PROCEND dispose_seg_access_with_handler;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] pmp$dispose_segment_access_cond', EJECT ??
*copyc pmh$dispose_segment_access_cond

  PROCEDURE [XDCL] pmp$dispose_segment_access_cond
    (    condition: mmt$segment_access_condition;
         sfsa: ^ost$stack_frame_save_area);


?? NEWTITLE := '  log_io_read_error', EJECT ??

    PROCEDURE log_io_read_error
      (    condition: mmt$segment_access_condition);

{   Purpose:
{ The purpose of this procedure is to emit a message to the job log
{ for an open permanent file, temporary file or transient segment.
{   Design:
{ Open catalogs are processed by PF condition handlers.  BACPF and
{ MOVE_CLASSES do not call FSP$OPEN_FILE for the PF that is being backed up
{ or moved; therefore, no Task File Table entry exists.  Therefore, at the
{ time the I/O read error is detected, a log message with ' Path Not Found '
{ is logged.  Subsequently, BACPF's or MOVE_CLASSES' condition handler logs
{ another message that provides the path.  The PVA is provided in all log
{ messages to correlate these redundant messages for the same error.

      CONST
        unknown_pf = '** Permanent FIle Path Not Found **',
        unknown_temp = '** Temporary FIle Path Not Found **';

      VAR
        entry_found: boolean,
        file_info: dmt$file_information,
        ignore_file_instance: ^bat$task_file_entry,
        ignore_path_handle: fmt$path_handle,
        index: integer,
        path: fst$path,
        path_size: fst$path_size,
        sfid: gft$system_file_identifier,
        status: ost$status;

      IF condition.identifier = mmc$sac_io_read_error THEN
        pfp$get_file_info (condition.segment, file_info, status);
        IF status.normal THEN
          CASE file_info.file_kind OF
          = gfc$fk_job_permanent_file, gfc$fk_job_local_file =
            bap$find_open_file_via_segment (#SEGMENT (condition.segment), ignore_file_instance, path,
                  path_size, entry_found);
            IF entry_found THEN
              osp$log_io_read_error (path (1, path_size), file_info.file_kind, condition.segment);
            ELSEIF file_info.file_kind = gfc$fk_job_permanent_file THEN
              osp$log_io_read_error (unknown_pf, file_info.file_kind, condition.segment);
            ELSE
              osp$log_io_read_error (unknown_temp, file_info.file_kind, condition.segment);
            IFEND;
          = gfc$fk_catalog =
            RETURN; {PF condition handler will log condition}
          = gfc$fk_device_file, gfc$fk_unnamed_file, gfc$fk_global_unnamed =
            osp$log_io_read_error ('', file_info.file_kind, condition.segment);
          ELSE
          CASEND;
        ELSE
          { Put out "transient segment" message even though the file is not attached}
          osp$log_io_read_error ('', gfc$fk_unnamed_file, condition.segment);
        IFEND;
      IFEND;

    PROCEND log_io_read_error;
?? OLDTITLE ??
    VAR
      call_debug: boolean,
      current_environment: pmt$condition_environment,
      status: ost$status,
      users_handler_found: boolean;

    status.normal := TRUE;
    current_environment.condition_save_area := sfsa;
    current_environment.condition.class := mmc$segment_access_condition;
    current_environment.condition.segment_access := condition;
    current_environment.condition_descriptor := NIL;
    current_environment.debug_index := 0;

    IF (sfsa^.minimum_save_area.p_register.pva.seg = #SEGMENT (^pma$vector_simulator)) AND
          (sfsa^.minimum_save_area.p_register.pva.offset >= #OFFSET (^pma$vector_simulator)) AND
          (sfsa^.minimum_save_area.p_register.pva.offset <= #OFFSET (^pma$vector_simulator_end)) THEN
      current_environment.condition_save_area := sfsa^.minimum_save_area.a2_previous_save_area;
    IFEND;

    log_io_read_error (condition);
    determine_call_debug (call_debug);
    IF NOT call_debug THEN
      find_users_handler (^current_environment, users_handler_found, status);
      IF status.normal AND users_handler_found THEN
        dispose_seg_access_with_handler (^current_environment, status);
      ELSE
        default_seg_access_cond_handler (^current_environment);
      IFEND;
    ELSE
      dispose_condition_with_debugger (^current_environment, sfsa, FALSE);
    IFEND;

    IF NOT status.normal THEN
      pmp$exit (status);
    IFEND;
  PROCEND pmp$dispose_segment_access_cond;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_job_resrce_with_handler', EJECT ??

{ PURPOSE:
{

  PROCEDURE dispose_job_resrce_with_handler
    (    current_environment {input, output} : ^pmt$condition_environment;
     VAR status: ost$status);


    VAR
      environment: pmt$condition_environment,
      handler_condition: pmt$condition,
      dispose_job_psa: ^ost$stack_frame_save_area;

?? NEWTITLE := 'dispose_of_handler_faults', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that faults
{   occuring during the call to a user's condition handler
{   are reported.

    PROCEDURE dispose_of_handler_faults
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR fault_status: ost$status);


      VAR
        ignore_status: ost$status;

{determine if call to the handler faulted or the handler itself faulted

      IF (save_area^.minimum_save_area.a2_previous_save_area <> dispose_job_psa) THEN

{call a user's handler if one is in effect

        pmp$continue_to_cause (pmc$execute_standard_procedure, fault_status);
      ELSE
        osp$set_status_from_condition (pmc$program_management_id, condition, save_area, status, status);
        IF (condition.selector <> pmc$system_conditions) OR
              ((condition.selector = pmc$system_conditions) AND
              NOT (pmc$detected_uncorrected_err IN condition.system_conditions)) THEN
          osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
          osp$set_status_from_condition (pmc$program_management_id, handler_condition,
                environment.condition_save_area, status, status);
          osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
          osp$set_status_abnormal (pmc$program_management_id, pme$invalid_condition_handler,
                'job resource conditions', status);
        IFEND;
        EXIT dispose_job_resrce_with_handler;
      IFEND;
    PROCEND dispose_of_handler_faults;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_of_nonlocal_exit', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that the previous
{   job resource condition environment is deleted before a user's
{   nonlocal exit completes.

    PROCEDURE dispose_of_nonlocal_exit
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);


      pmp$delete_environment (save_area, status);
      IF NOT status.normal THEN
        dispose_of_environment_overwrit (status);
      IFEND;
    PROCEND dispose_of_nonlocal_exit;
?? OLDTITLE, EJECT ??

    VAR
      fault_descriptor: pmt$established_handler,
      nonlocal_exit: pmt$established_handler,
      trap_enables: 0 .. 3,
      ignore_status: ost$status,
      delete: ost$status;

    dispose_job_psa := #PREVIOUS_SAVE_AREA ();
    environment := current_environment^;
    handler_condition.selector := jmc$job_resource_condition;
    handler_condition.job_resource_condition := environment.condition.job_resource;
    pmp$establish_condition_handler (condition_handler_faults, ^dispose_of_handler_faults, ^fault_descriptor,
          ignore_status);
    i#disable_traps (trap_enables);
    pmp$post_current_environment (^environment);
    pmp$establish_condition_handler (block_exit, ^dispose_of_nonlocal_exit, ^nonlocal_exit, ignore_status);
    i#enable_traps (trap_enables);

{call the user's condition handler

    set_debug_in_user_mask;
    environment.established_descriptor^.handler^ (handler_condition, environment.condition_descriptor, NIL,
          status);
    clear_debug_in_user_mask;
    pmp$delete_current_environment (delete);
    #WRITE_REGISTER (osc$pr_clear_critical_frame, 0);
    IF NOT delete.normal THEN
      dispose_of_environment_overwrit (delete);
    IFEND;
  PROCEND dispose_job_resrce_with_handler;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] pmp$dispose_job_resource_cond', EJECT ??
*copyc pmh$dispose_job_resource_cond

  PROCEDURE [XDCL] pmp$dispose_job_resource_cond
    (    job_resource_condition: jmt$job_resource_condition);


    VAR
      previous_save_area: ^ost$stack_frame_save_area;


    previous_save_area := #PREVIOUS_SAVE_AREA ();

    dispose_job_resource_condition (job_resource_condition, previous_save_area);
  PROCEND pmp$dispose_job_resource_cond;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_job_resource_condition', EJECT ??

{ PURPOSE:
{

  PROCEDURE dispose_job_resource_condition
    (    job_resource_condition: jmt$job_resource_condition;
         sfsa: ^ost$stack_frame_save_area);

    VAR
      call_debug: boolean,
      current_environment: pmt$condition_environment,
      executing_ring: ost$ring,
      post_status: ost$status,
      status: ost$status,
      users_handler_found: boolean;

    status.normal := TRUE;
    current_environment.condition_save_area := sfsa;
    current_environment.condition.class := jmc$job_resource_condition;
    current_environment.condition.job_resource := job_resource_condition;
    current_environment.condition_descriptor := NIL;
    current_environment.debug_index := 0;

    determine_call_debug (call_debug);
    IF NOT call_debug THEN
      find_users_handler (^current_environment, users_handler_found, status);
      IF status.normal THEN
        IF users_handler_found THEN
          dispose_job_resrce_with_handler (^current_environment, status);
        ELSE
          post_ring_crossing_condition (sfsa, ^current_environment, (#RING (^executing_ring) + 1),
                post_status, status);
          IF NOT post_status.normal THEN

{ posting the job resource condition found an inconsistent stack segment - the resource condition
{ will be ignored and continued execution of the task will detect the inconsistent stack again, at
{ which time the task will be aborted.

            status.normal := TRUE;
          IFEND;
        IFEND;
      ELSE

{ finding user's handler found an inconsistent stack segment or handler stack - the resource condition
{ will be ignored and continued execution of the task will detect the inconsistent stack again, at
{ which time the task will be aborted.

        status.normal := TRUE;
      IFEND;
    ELSE { call_debug = TRUE
      dispose_condition_with_debugger (^current_environment, sfsa, {multiple_conditions} FALSE);
    IFEND;
    IF NOT status.normal THEN
      pmp$exit (status);
    IFEND;
  PROCEND dispose_job_resource_condition;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_interactiv_with_handler', EJECT ??

{ PURPOSE:
{

  CONST
    continue_interactive_output = FALSE,
    terminate_interactive_output = TRUE;

  PROCEDURE dispose_interactiv_with_handler
    (    current_environment {input, output} : ^pmt$condition_environment;
     VAR status: ost$status);


    VAR
      environment: pmt$condition_environment,
      handler_condition: pmt$condition,
      dispose_interactive_psa: ^ost$stack_frame_save_area;

?? NEWTITLE := 'dispose_of_handler_faults', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that faults
{   occuring during the call to a user's condition handler
{   are reported.

    PROCEDURE dispose_of_handler_faults
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR fault_status: ost$status);

      VAR
        ignore_status: ost$status;

{determine if call to the handler faulted or the handler itself faulted

      IF (save_area^.minimum_save_area.a2_previous_save_area <> dispose_interactive_psa) THEN

{call a user's handler if one is in effect

        pmp$continue_to_cause (pmc$execute_standard_procedure, fault_status);
      ELSE
        osp$set_status_from_condition (pmc$program_management_id, condition, save_area, status, status);
        IF (condition.selector <> pmc$system_conditions) OR
              ((condition.selector = pmc$system_conditions) AND
              NOT (pmc$detected_uncorrected_err IN condition.system_conditions)) THEN
          osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
          osp$set_status_from_condition (pmc$program_management_id, handler_condition,
                environment.condition_save_area, status, status);
          osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
          osp$set_status_abnormal (pmc$program_management_id, pme$invalid_condition_handler,
                'interactive conditions', status);
        IFEND;
        EXIT dispose_interactiv_with_handler;
      IFEND;
    PROCEND dispose_of_handler_faults;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_of_nonlocal_exit', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that the previous
{   interactive condition environment is deleted before a user's
{   nonlocal exit completes.

    PROCEDURE dispose_of_nonlocal_exit
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);



      pmp$delete_environment (save_area, status);
      IF NOT status.normal THEN
        dispose_of_environment_overwrit (status);
      IFEND;
    PROCEND dispose_of_nonlocal_exit;
?? OLDTITLE, EJECT ??

    VAR
      fault_descriptor: pmt$established_handler,
      nonlocal_exit: pmt$established_handler,
      trap_enables: 0 .. 3,
      ignore_status: ost$status,
      delete: ost$status;

    dispose_interactive_psa := #PREVIOUS_SAVE_AREA ();
    environment := current_environment^;
    handler_condition.selector := ifc$interactive_condition;
    handler_condition.interactive_condition := environment.condition.interactive;
    pmp$establish_condition_handler (condition_handler_faults, ^dispose_of_handler_faults, ^fault_descriptor,
          ignore_status);
    i#disable_traps (trap_enables);
    pmp$post_current_environment (^environment);
    pmp$establish_condition_handler (block_exit, ^dispose_of_nonlocal_exit, ^nonlocal_exit, ignore_status);
    i#enable_traps (trap_enables);

{call the user's condition handler

    set_debug_in_user_mask;
    environment.established_descriptor^.handler^ (handler_condition, environment.condition_descriptor, NIL,
          status);
    clear_debug_in_user_mask;
    pmp$delete_current_environment (delete);
    #WRITE_REGISTER (osc$pr_clear_critical_frame, 0);
    IF NOT delete.normal THEN
      dispose_of_environment_overwrit (delete);
    IFEND;
  PROCEND dispose_interactiv_with_handler;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_interactive_condition', EJECT ??

{ PURPOSE:
{

  PROCEDURE dispose_interactive_condition
    (    interactive_condition: ift$interactive_condition;
         sfsa: ^ost$stack_frame_save_area;
         multiple_conditions: boolean);

?? NEWTITLE := 'dispose_of_nonlocal_exit', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that the end handler
{   request is issued before a user's nonlocal exit completes.

    PROCEDURE dispose_of_nonlocal_exit
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);

      jmp$end_timesharing_handler (interactive_condition);
    PROCEND dispose_of_nonlocal_exit;
?? OLDTITLE, EJECT ??

    VAR
      call_debug: boolean,
      executing_ring: ost$ring,
      status: ost$status,
      post_status: ost$status,
      ignore_status: ost$status,
      nonlocal_exit: pmt$established_handler,
      users_handler_found: boolean,
      current_environment: pmt$condition_environment;

    status.normal := TRUE;
    current_environment.condition_save_area := sfsa;
    current_environment.condition.class := ifc$interactive_condition;
    current_environment.condition.interactive := interactive_condition;
    current_environment.condition_descriptor := NIL;
    current_environment.debug_index := 0;
    pmp$establish_condition_handler (block_exit, ^dispose_of_nonlocal_exit, ^nonlocal_exit, ignore_status);

    jmp$begin_timesharing_handler (interactive_condition);
    determine_call_debug (call_debug);
    IF NOT call_debug THEN
      find_users_handler (^current_environment, users_handler_found, status);
      IF status.normal THEN
        IF users_handler_found THEN
          dispose_interactiv_with_handler (^current_environment, status);
        ELSE
          post_ring_crossing_condition (sfsa, ^current_environment, (#RING (^executing_ring) + 1) MOD 16,
                post_status, status);
          IF NOT post_status.normal THEN

{posting the interactive condition found an inconsistent stack segment - the interactive condition
{will be ignored and continued execution of the task will detect the inconsistent stack again, at
{which time the task will be aborted.

            status.normal := TRUE;
          IFEND;
        IFEND;
      ELSE

{finding user's handler found an inconsistent stack segment or handler stack - the interactive
{condition will be ignored and continued execution of the task will detect the inconsistent stack
{again, at which time the task will be aborted.

        status.normal := TRUE;
      IFEND;
    ELSE
      dispose_condition_with_debugger (^current_environment, sfsa, multiple_conditions);
    IFEND;
    jmp$end_timesharing_handler (interactive_condition);
    #WRITE_REGISTER (osc$pr_clear_critical_frame, 0);
    IF NOT status.normal THEN
      pmp$exit (status);
    IFEND;
  PROCEND dispose_interactive_condition;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] pmp$dispose_interactive_cond', EJECT ??
*copyc pmh$dispose_interactive_cond

  PROCEDURE [XDCL] pmp$dispose_interactive_cond
    (    interactive_condition: ift$interactive_condition);


    VAR
      previous_save_area: ^ost$stack_frame_save_area;


    previous_save_area := #PREVIOUS_SAVE_AREA ();

    dispose_interactive_condition (interactive_condition, previous_save_area, FALSE);
  PROCEND pmp$dispose_interactive_cond;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] pmp$dispose_of_delayed_cond', EJECT ??
*copyc pmh$dispose_of_delayed_cond

  PROCEDURE [XDCL] pmp$dispose_of_delayed_cond
    (    sfsa: ^ost$stack_frame_save_area);

    VAR
      delayed: pmt$delayed_condition;

?? NEWTITLE := 'dispose_of_nonlocal_exit', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that the end handler
{   request is issued before a user's nonlocal exit completes.

    PROCEDURE dispose_of_nonlocal_exit
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);

      jmp$end_timesharing_handler (delayed.interactive_condition);
    PROCEND dispose_of_nonlocal_exit;
?? OLDTITLE, EJECT ??

    VAR
      call_debug: boolean,
      condition_present: boolean,
      another_condition_present: boolean,
      environment: pmt$condition_environment,
      nonlocal_exit: pmt$established_handler,
      ignore_status: ost$status;

    another_condition_present := TRUE;
    WHILE another_condition_present DO
      pmp$get_delayed_condition (delayed, condition_present, another_condition_present);
      IF condition_present THEN
        CASE delayed.delayed_condition OF
        = debug =
          determine_call_debug (call_debug);
          IF call_debug THEN
            environment.condition := delayed.condition;
            environment.condition_save_area := ^delayed.condition_save_area;
            environment.condition_descriptor := NIL;
            environment.debug_index := delayed.debug_index;
            dispose_condition_with_debugger (^environment, sfsa, another_condition_present);
          ELSE

{DEBUGGER no longer active - ignore the condition

          IFEND;

        = job_resource =
          dispose_job_resource_condition (delayed.job_resource_condition, sfsa);

        = interactive =
          pmp$establish_condition_handler (block_exit, ^dispose_of_nonlocal_exit, ^nonlocal_exit,
                ignore_status);
          dispose_interactive_condition (delayed.interactive_condition, sfsa, another_condition_present);
          jmp$end_timesharing_handler (delayed.interactive_condition);

{ The end handler request balances
{ the begin handler request in post_ring_crossing_condition.

          #WRITE_REGISTER (osc$pr_clear_critical_frame, 0);

        = process_interval_timer =
          dispose_pit_condition (sfsa, another_condition_present);

        = user_condition =
          pmp$cause_task_condition (delayed.user_defined, delayed.condition_descriptor,
                delayed.propagate_info.notify_scl, delayed.propagate_info.notify_debug,
                delayed.propagate_info.propagate_to_parent, delayed.propagate_info.call_default_handler,
                ignore_status);
        CASEND;
      IFEND;
    WHILEND;
  PROCEND pmp$dispose_of_delayed_cond;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_of_user_condition', EJECT ??

{ PURPOSE:
{

  PROCEDURE dispose_of_user_condition
    (    current_environment {input, output} : ^pmt$condition_environment;
     VAR status: ost$status);


    VAR
      environment: pmt$condition_environment,
      handler_condition: pmt$condition,
      dispose_user_psa: ^ost$stack_frame_save_area;

?? NEWTITLE := 'dispose_of_handler_faults', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that faults
{   occuring during the call to a user's condition handler
{   are reported.

    PROCEDURE dispose_of_handler_faults
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR fault_status: ost$status);


      VAR
        ignore_status: ost$status;

{ If the condition is a recursive user defined condition and it is the same
{ condition that was passed to the user's condition handler, the condition
{ recurred within the handler (or another handler on the stack).  In this case
{ eat the condition.  This will end the condition and in the case of the volume
{ or space unavailable conditions, the task will go into wait.

      IF condition.selector = pmc$user_defined_condition THEN
        IF (condition.user_condition_name = active_user_condition_name) AND
              ((condition.user_condition_name = osc$volume_unavailable_cond) OR
              (condition.user_condition_name = osc$space_unavailable_condition) OR
              (condition.user_condition_name = osc$unseen_mail_condition)) THEN
          RETURN; { eat the condition

        ELSE { Its a different condition or was not a recursive condition.
          pmp$continue_to_cause (pmc$execute_standard_procedure, fault_status);
        IFEND;
      ELSE

{determine if call to the handler faulted or the handler itself faulted

        IF (save_area^.minimum_save_area.a2_previous_save_area <> dispose_user_psa) THEN

{call a user's handler if one is in effect

          pmp$continue_to_cause (pmc$execute_standard_procedure, fault_status);
        ELSE
          osp$set_status_from_condition (pmc$program_management_id, condition, save_area, status, status);
          IF (condition.selector <> pmc$system_conditions) OR
                ((condition.selector = pmc$system_conditions) AND
                NOT (pmc$detected_uncorrected_err IN condition.system_conditions)) THEN
            osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
            osp$set_status_from_condition (pmc$program_management_id, handler_condition,
                  environment.condition_save_area, status, status);
            osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
            osp$set_status_abnormal (pmc$program_management_id, pme$invalid_condition_handler,
                  'user defined conditions', status);
          IFEND;
          EXIT dispose_of_user_condition;
        IFEND;
      IFEND;
    PROCEND dispose_of_handler_faults;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_of_nonlocal_exit', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that the previous
{   user defined condition environment is deleted
{   before a user's nonlocal exit completes.

    PROCEDURE dispose_of_nonlocal_exit
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);

      pmp$delete_environment (save_area, status);
      IF NOT status.normal THEN
        dispose_of_environment_overwrit (status);
      IFEND;
    PROCEND dispose_of_nonlocal_exit;
?? OLDTITLE, EJECT ??

    VAR
      user_condition_handler_faults: [STATIC, READ, oss$job_paged_literal] pmt$condition :=
            [pmc$condition_combination, $pmt$condition_combination
            [pmc$system_conditions, mmc$segment_access_condition, pmc$user_defined_condition]],
      active_user_condition_name: pmt$condition_name,
      fault_descriptor: pmt$established_handler,
      nonlocal_exit: pmt$established_handler,
      trap_enables: 0 .. 3,
      ignore_status: ost$status,
      delete: ost$status;

    dispose_user_psa := #PREVIOUS_SAVE_AREA ();
    environment := current_environment^;
    environment.debug_index := 0;
    handler_condition.selector := pmc$user_defined_condition;
    handler_condition.user_condition_name := environment.condition.user_defined;
    active_user_condition_name := environment.condition.user_defined;
    #SPOIL (active_user_condition_name);
    pmp$establish_condition_handler (user_condition_handler_faults, ^dispose_of_handler_faults,
          ^fault_descriptor, ignore_status);
    i#disable_traps (trap_enables);
    pmp$post_current_environment (^environment);
    pmp$establish_condition_handler (block_exit, ^dispose_of_nonlocal_exit, ^nonlocal_exit, ignore_status);
    i#enable_traps (trap_enables);
    set_debug_in_user_mask;

{call the user's condition handler

    environment.established_descriptor^.handler^ (handler_condition, environment.condition_descriptor, NIL,
          status);
    clear_debug_in_user_mask;
    pmp$delete_current_environment (delete);
    #WRITE_REGISTER (osc$pr_clear_critical_frame, 0);
    IF NOT delete.normal THEN
      dispose_of_environment_overwrit (delete);
    IFEND;
  PROCEND dispose_of_user_condition;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE {retained}] pmp$cause_condition', EJECT ??
*copyc pmh$cause_condition

  PROCEDURE [XDCL, #GATE {retained} ] pmp$cause_condition
    (    condition_name: pmt$condition_name;
         condition_descriptor: ^pmt$condition_information;
     VAR status: ost$status);

    VAR
      call_debug: boolean,
      name: ost$name,
      cause_status: ost$status,
      users_handler_found: boolean,
      current_environment: pmt$condition_environment,
      valid_name: boolean;

    clp$validate_name (condition_name, name, valid_name);
    IF valid_name THEN
      cause_status.normal := TRUE;
      current_environment.condition_save_area := #PREVIOUS_SAVE_AREA ();
      current_environment.condition.class := pmc$user_defined_condition;
      current_environment.condition.user_defined := name;
      current_environment.condition_descriptor := condition_descriptor;
      current_environment.debug_index := 0;
      current_environment.condition.propagate_info.scope := pmc$current_ring;

      determine_call_debug (call_debug);
      IF NOT call_debug THEN
        find_users_handler (^current_environment, users_handler_found, cause_status);
        IF cause_status.normal THEN
          IF users_handler_found THEN
            dispose_of_user_condition (^current_environment, cause_status);
            IF NOT cause_status.normal THEN
              pmp$exit (cause_status);
            IFEND;
          ELSE
            osp$set_status_abnormal (pmc$program_management_id, pme$no_established_handler, '', cause_status);
          IFEND;
        IFEND;
      ELSE
        dispose_condition_with_debugger (^current_environment, current_environment.condition_save_area,
              FALSE);
      IFEND;
    ELSE
      osp$set_status_abnormal ('CL', cle$improper_name, condition_name, cause_status);
    IFEND;

    IF cause_status.normal THEN
      status.normal := TRUE;
    ELSE
      status := cause_status;
    IFEND;


  PROCEND pmp$cause_condition;
?? OLDTITLE ??
?? NEWTITLE := 'find_handler_in_stacks', EJECT ??

{ PURPOSE:
{

  PROCEDURE find_handler_in_stacks
    (    condition: pmt$internal_condition;
         last_save_area: ^ost$stack_frame_save_area;
     VAR handler_found: boolean;
     VAR continue_status: ost$status);

?? NEWTITLE := 'dispose_of_stack_read_error', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that segment access
{   conditions which may arise when scanning stack frames are reported.

    PROCEDURE dispose_of_stack_read_error
      (    segment_access_condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR ignore_status: ost$status);

      osp$set_status_from_condition (pmc$program_management_id, segment_access_condition, save_area,
            continue_status, continue_status);
      osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], continue_status, ignore_status);
      osp$set_status_abnormal (pmc$program_management_id, pme$inconsistent_stack, '', continue_status);

      EXIT find_handler_in_stacks;

    PROCEND dispose_of_stack_read_error;
?? OLDTITLE, EJECT ??

    VAR
      established_descriptor: ^pmt$established_handler,
      next_save_area: ^ost$stack_frame_save_area,
      read_error_descriptor: pmt$established_handler,
      ignore_status: ost$status;

    pmp$establish_condition_handler (stack_read_error, ^dispose_of_stack_read_error, ^read_error_descriptor,
          ignore_status);
    next_save_area := last_save_area^.minimum_save_area.a2_previous_save_area;
    handler_found := FALSE;
    continue_status.normal := TRUE;
    WHILE NOT handler_found AND (next_save_area <> NIL) AND (#RING (next_save_area) <= osc$user_ring_2) AND
          continue_status.normal DO
      pmp$is_there_a_handler_in_stack (condition, next_save_area, established_descriptor, next_save_area,
            continue_status);
      IF continue_status.normal THEN
        IF (established_descriptor <> NIL) THEN
          handler_found := TRUE;
        ELSE
          next_save_area := next_save_area^.minimum_save_area.a2_previous_save_area;
        IFEND;
      IFEND;
    WHILEND;
  PROCEND find_handler_in_stacks;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE {retained}] pmp$continue_to_cause', EJECT ??
*copyc pmh$continue_to_cause

  PROCEDURE [XDCL, {user} #GATE] pmp$continue_to_cause
    (    standard: pmt$standard_selection;
     VAR status: ost$status);

?? NEWTITLE := 'find_next_users_handler', EJECT ??

{ PURPOSE:
{

    PROCEDURE find_next_users_handler
      (    environment {input, output} : ^pmt$condition_environment;
       VAR handler_found: boolean;
       VAR status: ost$status);

?? NEWTITLE := 'dispose_of_environment_overwrit', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that if an environment
{   has been overwritten that the environment is deleted and the user
{   of pmp$continue_to_cause is informed that a continue cannot be
{   preformed.

      PROCEDURE dispose_of_environment_overwrit
        (    condition: pmt$condition;
             condition_descriptor: ^pmt$condition_information;
             save_area: ^ost$stack_frame_save_area;
         VAR overwrite_status: ost$status);

        osp$set_status_abnormal (pmc$program_management_id, pme$stack_overwritten, '', status);
        pmp$delete_current_environment (overwrite_status);
        EXIT find_next_users_handler;
      PROCEND dispose_of_environment_overwrit;
?? OLDTITLE ??
?? NEWTITLE := 'dispose_of_stack_read_error', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that segment access
{   conditions which may arise when scanning stack frames are reported.

      PROCEDURE dispose_of_stack_read_error
        (    segment_access_condition: pmt$condition;
             condition_descriptor: ^pmt$condition_information;
             save_area: ^ost$stack_frame_save_area;
         VAR ignore_status: ost$status);

        osp$set_status_from_condition (pmc$program_management_id, segment_access_condition, save_area, status,
              status);
        osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
        osp$set_status_abnormal (pmc$program_management_id, pme$inconsistent_stack, '', status);

        EXIT find_next_users_handler;

      PROCEND dispose_of_stack_read_error;
?? OLDTITLE, EJECT ??

      VAR
        read_error_descriptor: pmt$established_handler,
        descriptor: pmt$established_handler,
        ignore_status: ost$status,
        current_handler: ^pmt$established_handler;

*copyc pmp$find_next_handler_in_stack
*copyc pmp$find_next_handler_in_frame

      pmp$establish_condition_handler (stack_read_error, ^dispose_of_stack_read_error, ^read_error_descriptor,
            ignore_status);
      pmp$establish_condition_handler (environment_overwrite, ^dispose_of_environment_overwrit, ^descriptor,
            ignore_status);
      current_handler := environment^.established_descriptor;
      IF (environment^.condition.class = pmc$block_exit_processing) THEN
        pmp$find_next_handler_in_frame (environment^.condition, environment^.handler_save_area,
              environment^.established_descriptor, environment^.established_descriptor, status);
      ELSE
        pmp$find_next_handler_in_stack (environment^.condition, environment^.handler_save_area,
              environment^.established_descriptor, environment^.established_descriptor,
              environment^.handler_save_area, status);
      IFEND;

      IF status.normal THEN
        IF (current_handler <> environment^.established_descriptor) THEN
          handler_found := (environment^.established_descriptor <> NIL);
        ELSE
          osp$set_status_abnormal (pmc$program_management_id, pme$handler_stack_error, '  ', status);
        IFEND;
      IFEND;

    PROCEND find_next_users_handler;
?? OLDTITLE, EJECT ??

    VAR
      current_environment: pmt$condition_environment,
      condition_handler_active: boolean,
      users_handler_found: boolean,
      active_segment: ost$segment,
      condition_segment: ost$segment,
      executing_ring: ost$ring,
      continue_status: ost$status,
      ignore_status: ost$status;

    status.normal := TRUE;
    pmp$get_current_environment (current_environment, condition_handler_active, continue_status);
    IF continue_status.normal THEN
      IF condition_handler_active THEN
        CASE current_environment.condition.class OF


        = pmc$system_conditions =
          IF (current_environment.condition.system <> pmc$debug_unselectable) THEN
            find_next_users_handler (^current_environment, users_handler_found, continue_status);
            IF continue_status.normal THEN
              IF users_handler_found THEN
                IF NOT (current_environment.condition.system IN
                      current_environment.established_descriptor^.handler_active.system) THEN
                  dispose_system_with_handler (^current_environment, continue_status);
                  IF NOT continue_status.normal THEN
                    IF continue_status.condition <> pme$invalid_condition_handler THEN
                      pmp$exit (continue_status);
                    IFEND;
                  IFEND;
                ELSE
                  osp$set_status_abnormal (pmc$program_management_id, pme$recursive_continue,
                        'system condition', continue_status);
                IFEND;
              ELSE
                CASE standard OF
                = pmc$execute_standard_procedure =
                  default_system_cond_handler (^current_environment, { inconsistent_stack } FALSE);
                = pmc$inhibit_standard_procedure =
                  osp$set_status_abnormal (pmc$program_management_id, pme$no_established_handler, '',
                        continue_status);
                ELSE
                  osp$set_status_abnormal (pmc$program_management_id, pme$invalid_standard_selection, '',
                        continue_status);
                CASEND;
              IFEND;
            IFEND;

          ELSE
            osp$set_status_abnormal (pmc$program_management_id, pme$no_condition_to_continue, '',
                  continue_status);
          IFEND;

        = pmc$block_exit_processing =
          find_next_users_handler (^current_environment, users_handler_found, continue_status);
          IF continue_status.normal THEN
            IF users_handler_found THEN
              dispose_block_exit_with_handler (^current_environment, continue_status);
              IF NOT continue_status.normal THEN
                IF (continue_status.condition <> pme$invalid_condition_handler) THEN
                  pmp$exit (continue_status);
                IFEND;
              IFEND;
            ELSE
              CASE standard OF
              = pmc$execute_standard_procedure =
                ;
              = pmc$inhibit_standard_procedure =
                osp$set_status_abnormal (pmc$program_management_id, pme$no_established_handler, '',
                      continue_status);
              ELSE
                osp$set_status_abnormal (pmc$program_management_id, pme$invalid_standard_selection, '',
                      continue_status);
              CASEND;
            IFEND;
          IFEND;


        = jmc$job_resource_condition =
          find_next_users_handler (^current_environment, users_handler_found, continue_status);
          IF continue_status.normal THEN
            IF users_handler_found THEN
              dispose_job_resrce_with_handler (^current_environment, continue_status);
              IF NOT continue_status.normal THEN
                IF (continue_status.condition <> pme$invalid_condition_handler) THEN
                  pmp$exit (continue_status);
                IFEND;
              IFEND;
            ELSE
              find_handler_in_stacks (current_environment.condition, current_environment.handler_save_area,
                    users_handler_found, continue_status);
              IF continue_status.normal THEN
                IF users_handler_found THEN
                  post_ring_crossing_condition (current_environment.handler_save_area, ^current_environment,
                        #RING (^executing_ring) + 1, continue_status, continue_status);

{#ring (^executing_ring) + 1 is the current ring of execution + 1

                ELSE
                  CASE standard OF
                  = pmc$execute_standard_procedure =
                    post_ring_crossing_condition (current_environment.handler_save_area, ^current_environment,
                          #RING (^executing_ring) + 1, continue_status, continue_status);

{#ring (^executing_ring) + 1 is the current ring of execution + 1

                  = pmc$inhibit_standard_procedure =
                    osp$set_status_abnormal (pmc$program_management_id, pme$no_established_handler, '',
                          continue_status);
                  ELSE
                    osp$set_status_abnormal (pmc$program_management_id, pme$invalid_standard_selection, '',
                          continue_status);
                  CASEND;
                IFEND;
              IFEND;
            IFEND;
          IFEND;


        = mmc$segment_access_condition =
          find_next_users_handler (^current_environment, users_handler_found, continue_status);
          IF continue_status.normal THEN
            IF users_handler_found THEN
              active_segment := #SEGMENT (current_environment.established_descriptor^.handler_active.
                    segment_access.segment);
              condition_segment := #SEGMENT (current_environment.condition.segment_access.segment);
              IF (current_environment.condition.segment_access.identifier <>
                    current_environment.established_descriptor^.handler_active.segment_access.identifier) AND
                    ((current_environment.established_descriptor^.handler_active.segment_access.segment =
                    NIL) OR (condition_segment <> active_segment)) THEN
                dispose_seg_access_with_handler (^current_environment, continue_status);
                IF NOT continue_status.normal THEN
                  IF (continue_status.condition <> pme$invalid_condition_handler) THEN
                    pmp$exit (continue_status);
                  IFEND;
                IFEND;
              ELSE
                osp$set_status_abnormal (pmc$program_management_id, pme$recursive_continue,
                      'segment access condition', continue_status);
              IFEND;
            ELSE
              CASE standard OF
              = pmc$execute_standard_procedure =
                default_seg_access_cond_handler (^current_environment);
              = pmc$inhibit_standard_procedure =
                osp$set_status_abnormal (pmc$program_management_id, pme$no_established_handler, '',
                      continue_status);
              ELSE
                osp$set_status_abnormal (pmc$program_management_id, pme$invalid_standard_selection, '',
                      continue_status);
              CASEND;
            IFEND;
          IFEND;


        = ifc$interactive_condition =
          find_next_users_handler (^current_environment, users_handler_found, continue_status);
          IF continue_status.normal THEN
            IF users_handler_found THEN
              dispose_interactiv_with_handler (^current_environment, continue_status);
              IF NOT continue_status.normal THEN
                IF (continue_status.condition <> pme$invalid_condition_handler) THEN
                  pmp$exit (continue_status);
                IFEND;
              IFEND;
            ELSE
              find_handler_in_stacks (current_environment.condition, current_environment.handler_save_area,
                    users_handler_found, continue_status);
              IF continue_status.normal THEN
                IF users_handler_found THEN
                  post_ring_crossing_condition (current_environment.handler_save_area, ^current_environment,
                        #RING (^executing_ring) + 1, continue_status, continue_status);

{#ring (^executing_ring) + 1 is the current ring of execution + 1

                ELSE
                  CASE standard OF
                  = pmc$execute_standard_procedure =
                    post_ring_crossing_condition (current_environment.handler_save_area, ^current_environment,
                          #RING (^executing_ring) + 1, continue_status, continue_status);

{#ring (^executing_ring) + 1 is the current ring of execution + 1

                  = pmc$inhibit_standard_procedure =
                    osp$set_status_abnormal (pmc$program_management_id, pme$no_established_handler, '',
                          continue_status);
                  ELSE
                    osp$set_status_abnormal (pmc$program_management_id, pme$invalid_standard_selection, '',
                          continue_status);
                  CASEND;
                IFEND;
              IFEND;
            IFEND;
          IFEND;


        = pmc$pit_condition =
          find_next_users_handler (^current_environment, users_handler_found, continue_status);
          IF continue_status.normal THEN
            IF users_handler_found THEN
              dispose_pit_with_handler (^current_environment, continue_status);
              IF NOT continue_status.normal THEN
                IF (continue_status.condition <> pme$invalid_condition_handler) THEN
                  pmp$exit (continue_status);
                IFEND;
              IFEND;
            ELSE
              find_handler_in_stacks (current_environment.condition, current_environment.handler_save_area,
                    users_handler_found, continue_status);
              IF continue_status.normal THEN
                IF users_handler_found THEN
                  post_ring_crossing_condition (current_environment.handler_save_area, ^current_environment,
                        #RING (^executing_ring) + 1, continue_status, continue_status);

{#ring (^executing_ring) + 1 is the current ring of execution + 1

                ELSE
                  CASE standard OF
                  = pmc$execute_standard_procedure =
                    ;
                  = pmc$inhibit_standard_procedure =
                    osp$set_status_abnormal (pmc$program_management_id, pme$no_established_handler, '',
                          continue_status);
                  ELSE
                    osp$set_status_abnormal (pmc$program_management_id, pme$invalid_standard_selection, '',
                          continue_status);
                  CASEND;
                IFEND;
              IFEND;
            IFEND;
          IFEND;


        = pmc$user_defined_condition =
          find_next_users_handler (^current_environment, users_handler_found, continue_status);
          IF continue_status.normal THEN
            IF users_handler_found THEN
              dispose_of_user_condition (^current_environment, continue_status);
              IF NOT continue_status.normal THEN
                IF (continue_status.condition <> pme$invalid_condition_handler) THEN
                  pmp$exit (continue_status);
                IFEND;
              IFEND;
            ELSE
              IF current_environment.condition.propagate_info.scope = pmc$current_ring THEN
                CASE standard OF
                = pmc$execute_standard_procedure =
                  ;
                = pmc$inhibit_standard_procedure =
                  osp$set_status_abnormal (pmc$program_management_id, pme$no_established_handler, '',
                        continue_status);
                ELSE
                  osp$set_status_abnormal (pmc$program_management_id, pme$invalid_standard_selection, '',
                        continue_status);
                CASEND;
              ELSE

{ propagate user condition across rings

                find_handler_in_stacks (current_environment.condition, current_environment.handler_save_area,
                      users_handler_found, continue_status);
                IF continue_status.normal THEN
                  IF users_handler_found THEN
                    post_ring_crossing_condition (current_environment.handler_save_area, ^current_environment,
                          #RING (^executing_ring) + 1, continue_status, continue_status);

{#ring (^executing_ring) + 1 is the current ring of execution + 1

                  ELSE
                    CASE standard OF
                    = pmc$execute_standard_procedure =
                      post_ring_crossing_condition (current_environment.handler_save_area,
                            ^current_environment, #RING (^executing_ring) + 1, continue_status,
                            continue_status);

{#ring (^executing_ring) + 1 is the current ring of execution + 1

                    = pmc$inhibit_standard_procedure =
                      osp$set_status_abnormal (pmc$program_management_id, pme$no_established_handler, '',
                            continue_status);
                    ELSE
                      osp$set_status_abnormal (pmc$program_management_id, pme$invalid_standard_selection, '',
                            continue_status);
                    CASEND;
                  IFEND;
                IFEND;
              IFEND; {propagate across rings}
            IFEND;
          IFEND;
        ELSE

{the environment has been overwritten delete the environment

          pmp$delete_current_environment (ignore_status);
          osp$set_status_abnormal (pmc$program_management_id, pme$stack_overwritten, '', continue_status);
          osp$append_status_integer (osc$status_parameter_delimiter, #RING (^executing_ring), 16, FALSE,
                continue_status);
        CASEND;
      ELSE
        osp$set_status_abnormal (pmc$program_management_id, pme$no_condition_to_continue, '',
              continue_status);
      IFEND;
    ELSE
      osp$append_status_integer (osc$status_parameter_delimiter, #RING (^executing_ring), 16, FALSE,
            continue_status);
    IFEND;

    IF continue_status.normal THEN
      status.normal := TRUE;
    ELSE
      status := continue_status;
    IFEND;

  PROCEND pmp$continue_to_cause;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE {RETAINED}] pmp$test_condition_handler', EJECT ??
*copyc pmh$test_condition_handler

  PROCEDURE [XDCL, #GATE {retained} ] pmp$test_condition_handler
    (    conditions: pmt$condition;
         save_area: ^ost$stack_frame_save_area;
     VAR status: ost$status);

?? NEWTITLE := 'find_handler', EJECT ??

{ PURPOSE:
{

    PROCEDURE find_handler
      (    condition: pmt$internal_condition;
           save_area: ^ost$stack_frame_save_area;
           environment {input, output} : ^pmt$condition_environment;
       VAR handler_found: boolean;
       VAR status: ost$status);

?? NEWTITLE := 'dispose_of_stack_read_error', EJECT ??

{ PURPOSE:
{   This procedure (condition handler) ensures that segment access
{   conditions which may arise when scanning stack frames are reported.

      PROCEDURE dispose_of_stack_read_error
        (    segment_access_condition: pmt$condition;
             condition_descriptor: ^pmt$condition_information;
             save_area: ^ost$stack_frame_save_area;
         VAR ignore_status: ost$status);

        osp$set_status_from_condition (pmc$program_management_id, segment_access_condition, save_area, status,
              status);
        osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
        osp$set_status_abnormal (pmc$program_management_id, pme$inconsistent_stack, '', status);

        EXIT find_handler;

      PROCEND dispose_of_stack_read_error;
?? OLDTITLE, EJECT ??

      VAR
        read_error_descriptor: pmt$established_handler,
        ignore_status: ost$status;

      pmp$establish_condition_handler (stack_read_error, ^dispose_of_stack_read_error, ^read_error_descriptor,
            ignore_status);
      pmp$find_handler_in_stack (condition, save_area, environment^.established_descriptor,
            environment^.handler_save_area, status);

      IF status.normal THEN
        handler_found := (environment^.established_descriptor <> NIL);
      ELSE
        osp$generate_log_message ($pmt$ascii_logset [pmc$job_log], status, ignore_status);
      IFEND;
    PROCEND find_handler;
?? OLDTITLE, EJECT ??

    VAR
      traps: 0 .. 3,
      call_debug: boolean,
      executing_ring: ost$ring,
      outstanding_system: pmt$system_conditions,
      callers_save_area: ^ost$stack_frame_save_area,
      current_environment: pmt$condition_environment,
      handler_found: boolean,
      test_status: ost$status;

    i#enable_traps (traps);
    callers_save_area := #PREVIOUS_SAVE_AREA ();
    test_status.normal := TRUE;
    current_environment.debug_index := 0;

    CASE conditions.selector OF
    = pmc$system_conditions =
      current_environment.condition.class := pmc$system_conditions;
      current_environment.condition.system := pmc$detected_uncorrected_err;
      current_environment.condition.untranslatable_pointer := conditions.untranslatable_pointer;
      current_environment.condition_descriptor := NIL;
      current_environment.condition_save_area := save_area;
      outstanding_system := conditions.system_conditions;

      WHILE (current_environment.condition.system <= pmc$invalid_bdp_data) AND
            (outstanding_system <> $pmt$system_conditions []) AND test_status.normal DO
        IF (current_environment.condition.system IN conditions.system_conditions) THEN

          determine_call_debug (call_debug);
          IF NOT call_debug THEN
            find_handler (current_environment.condition, callers_save_area, ^current_environment,
                  handler_found, test_status);
            IF test_status.normal THEN
              IF handler_found THEN
                dispose_system_with_handler (^current_environment, test_status);
                IF NOT test_status.normal THEN
                  IF (test_status.condition <> pme$invalid_condition_handler) THEN
                    pmp$exit (test_status);
                  IFEND;
                IFEND;
              ELSE
                osp$set_status_abnormal (pmc$program_management_id, pme$no_established_handler, '',
                      test_status);
              IFEND;
            IFEND;
          ELSE
            dispose_condition_with_debugger (^current_environment, callers_save_area, FALSE);
          IFEND;
          outstanding_system := (outstanding_system - $pmt$system_conditions
                [current_environment.condition.system]);
        IFEND;
        IF current_environment.condition.system < pmc$invalid_bdp_data THEN
          current_environment.condition.system := SUCC (current_environment.condition.system);
        IFEND;
      WHILEND;

    = pmc$block_exit_processing =
      osp$set_status_abnormal (pmc$program_management_id, pme$unsupported_by_test_cond, '', test_status);

    = mmc$segment_access_condition =
      current_environment.condition.class := mmc$segment_access_condition;
      current_environment.condition_save_area := save_area;
      current_environment.condition.segment_access := conditions.segment_access_condition;
      current_environment.condition_descriptor := NIL;
      current_environment.debug_index := 0;

      determine_call_debug (call_debug);
      IF NOT call_debug THEN
        find_handler (current_environment.condition, callers_save_area, ^current_environment, handler_found,
              test_status);
        IF test_status.normal THEN
          IF handler_found THEN
            dispose_seg_access_with_handler (^current_environment, test_status);
            IF NOT test_status.normal THEN
              IF (test_status.condition <> pme$invalid_condition_handler) THEN
                pmp$exit (test_status);
              IFEND;
            IFEND;
          ELSE
            osp$set_status_abnormal (pmc$program_management_id, pme$no_established_handler, '', test_status);
          IFEND;
        IFEND;
      ELSE
        dispose_condition_with_debugger (^current_environment, callers_save_area, FALSE);
      IFEND;

    = jmc$job_resource_condition =
      current_environment.condition.class := jmc$job_resource_condition;
      current_environment.condition.job_resource := conditions.job_resource_condition;
      current_environment.condition_descriptor := NIL;
      current_environment.condition_save_area := callers_save_area;
      current_environment.debug_index := 0;

      find_handler (current_environment.condition, callers_save_area, ^current_environment, handler_found,
            test_status);
      IF test_status.normal THEN
        IF handler_found THEN
          dispose_job_resrce_with_handler (^current_environment, test_status);
          IF NOT test_status.normal THEN
            IF (test_status.condition <> pme$invalid_condition_handler) THEN
              pmp$exit (test_status);
            IFEND;
          IFEND;
        ELSE
          find_handler_in_stacks (current_environment.condition, callers_save_area, handler_found,
                test_status);
          IF test_status.normal THEN
            IF handler_found THEN
              post_ring_crossing_condition (current_environment.handler_save_area, ^current_environment,
                    #RING (^executing_ring) + 1, test_status, test_status);

{#ring (^executing_ring) + 1 is the current ring of execution + 1

            ELSE
              osp$set_status_abnormal (pmc$program_management_id, pme$no_established_handler, '',
                    test_status);
            IFEND;
          IFEND;
        IFEND;
      IFEND;

    = ifc$interactive_condition =
      current_environment.condition.class := ifc$interactive_condition;
      current_environment.condition.interactive := conditions.interactive_condition;
      current_environment.condition_descriptor := NIL;
      current_environment.condition_save_area := callers_save_area;
      current_environment.debug_index := 0;

      determine_call_debug (call_debug);
      IF NOT call_debug THEN
        find_handler (current_environment.condition, callers_save_area, ^current_environment, handler_found,
              test_status);
        IF test_status.normal THEN
          IF handler_found THEN
            dispose_interactiv_with_handler (^current_environment, test_status);
            IF NOT test_status.normal THEN
              IF (test_status.condition <> pme$invalid_condition_handler) THEN
                pmp$exit (test_status);
              IFEND;
            IFEND;
          ELSE
            find_handler_in_stacks (current_environment.condition, callers_save_area, handler_found,
                  test_status);
            IF test_status.normal THEN
              IF handler_found THEN
                post_ring_crossing_condition (current_environment.handler_save_area, ^current_environment,
                      #RING (^executing_ring) + 1, test_status, test_status);

{#ring (^executing_ring) + 1 is the current ring of execution + 1

              ELSE
                osp$set_status_abnormal (pmc$program_management_id, pme$no_established_handler, '',
                      test_status);
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      ELSE
        dispose_condition_with_debugger (^current_environment, callers_save_area, FALSE);
      IFEND;

    = pmc$pit_condition =
      current_environment.condition.class := pmc$pit_condition;
      current_environment.condition_descriptor := NIL;
      current_environment.condition_save_area := callers_save_area;
      current_environment.debug_index := 0;

      determine_call_debug (call_debug);
      IF NOT call_debug THEN
        find_handler (current_environment.condition, callers_save_area, ^current_environment, handler_found,
              test_status);
        IF test_status.normal THEN
          IF handler_found THEN
            dispose_pit_with_handler (^current_environment, test_status);
            IF NOT test_status.normal THEN
              IF (test_status.condition <> pme$invalid_condition_handler) THEN
                pmp$exit (test_status);
              IFEND;
            IFEND;
          ELSE
            find_handler_in_stacks (current_environment.condition, callers_save_area, handler_found,
                  test_status);
            IF test_status.normal THEN
              IF handler_found THEN
                post_ring_crossing_condition (current_environment.handler_save_area, ^current_environment,
                      #RING (^executing_ring) + 1, test_status, test_status);

{#ring (^executing_ring) + 1 is the current ring of execution + 1

              ELSE
                osp$set_status_abnormal (pmc$program_management_id, pme$no_established_handler, '',
                      test_status);
              IFEND;
            IFEND;
          IFEND;
        IFEND;
      ELSE
        dispose_condition_with_debugger (^current_environment, callers_save_area, FALSE);
      IFEND;

    ELSE
      osp$set_status_abnormal (pmc$program_management_id, pme$unsupported_by_test_cond, '', test_status);
    CASEND;

    IF test_status.normal THEN
      status.normal := TRUE;
    ELSE
      status := test_status;
    IFEND;

    i#restore_traps (traps);

  PROCEND pmp$test_condition_handler;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE {retained}] pmp$cause_task_condition', EJECT ??

  PROCEDURE [XDCL, #GATE {retained} ] pmp$cause_task_condition
    (    condition_name: pmt$condition_name;
         condition_descriptor: ^pmt$condition_information;
         notify_scl: boolean;
         notify_debug: boolean;
         propagate_to_parent: boolean;
         call_default_handler: boolean;
     VAR status: ost$status);


    VAR
      call_debug: boolean,
      name: ost$name,
      executing_ring: ost$ring,
      sfsa: ^ost$stack_frame_save_area,
      post_status,
      cause_status: ost$status,
      users_handler_found: boolean,
      ignore_status: ost$status,
      current_environment: pmt$condition_environment,
      valid_name: boolean;

    clp$validate_name (condition_name, name, valid_name);
    IF valid_name THEN
      cause_status.normal := TRUE;
      sfsa := #PREVIOUS_SAVE_AREA ();
      current_environment.condition_save_area := #PREVIOUS_SAVE_AREA ();
      current_environment.condition.class := pmc$user_defined_condition;
      current_environment.condition.user_defined := name;
      current_environment.condition_descriptor := condition_descriptor;
      current_environment.condition.propagate_info.scope := pmc$current_task;
      current_environment.condition.propagate_info.notify_scl := notify_scl;
      current_environment.condition.propagate_info.notify_debug := notify_debug;
      current_environment.condition.propagate_info.propagate_to_parent := propagate_to_parent;
      current_environment.condition.propagate_info.call_default_handler := call_default_handler;
      current_environment.debug_index := 0;

      determine_call_debug (call_debug);
      IF (NOT call_debug) OR (NOT notify_debug) THEN
        find_users_handler (^current_environment, users_handler_found, cause_status);
        IF cause_status.normal THEN
          IF users_handler_found THEN
            dispose_of_user_condition (^current_environment, cause_status);
            IF NOT cause_status.normal THEN
              pmp$exit (cause_status);
            IFEND;
          ELSE
            post_ring_crossing_condition (sfsa, ^current_environment, (#RING (^executing_ring) + 1) MOD 16,
                  post_status, status);
            IF NOT post_status.normal THEN

{posting the condition found an inconsistent stack segment - the condition
{will be ignored and continued execution of the task will detect the
{inconsistent stack again, at which time the task will be aborted.

              status.normal := TRUE;
            IFEND;
          IFEND;
        IFEND;
      ELSE
        dispose_condition_with_debugger (^current_environment, current_environment.condition_save_area,
              FALSE);
      IFEND;
    ELSE
      osp$set_status_abnormal ('CL', cle$improper_name, condition_name, cause_status);
    IFEND;

    IF cause_status.normal THEN
      status.normal := TRUE;
    ELSE
      status := cause_status;
    IFEND;

  PROCEND pmp$cause_task_condition;
?? OLDTITLE ??
?? NEWTITLE := 'default_user_defined_handler', EJECT ??

  PROCEDURE default_user_defined_handler
    (    condition: pmt$condition;
     VAR status: ost$status);

    VAR
      str: string (80),
      strl: integer;


    STRINGREP (str, strl, 'USER DEFINED CONDITION ', condition.user_condition_name, ' IGNORED');
    pmp$log (str (1, strl), status);

  PROCEND default_user_defined_handler;
?? OLDTITLE ??
?? NEWTITLE := 'ignore_user_defined_condition', EJECT ??

  PROCEDURE ignore_user_defined_condition
    (    condition: pmt$condition;
     VAR status: ost$status);

{ Do nothing.

  PROCEND ignore_user_defined_condition;
?? OLDTITLE ??
MODEND pmm$dispose_of_conditions;
