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

{   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$work_area_overflow
*copyc ife$interactive_exception_codes
*copyc jme$job_management_conditions
*copyc llc$unlinked_pointer_ring
*copyc mmc$first_transient_segment
*copyc mmd$segment_access_condition
*copyc mme$condition_codes
*copyc osc$default_utp_ring
*copyc osc$processor_defined_registers
*copyc osd$code_base_pointer
*copyc osd$keypoints
*copyc ose$condition_exceptions
*copyc oss$job_paged_literal
*copyc ost$name
*copyc ost$stack_frame_save_area
*copyc ost$status
*copyc ost$status_identifier
*copyc pme$system_exceptions
*copyc pmt$condition
?? POP ??
*copyc bap$format_segment_condition
*copyc clp$convert_integer_to_string
*copyc clv$work_areas
*copyc mmp$fetch_segment_attributes
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc pmp$call_ring_crossing_proc
*copyc pmp$establish_condition_handler
*copyc pmp$get_binary_mainframe_id
*copyc pmp$validate_previous_save_area
*copyc sfp$get_job_limit_name
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  VAR
    ring_crossing_routine: [STATIC, READ, oss$job_paged_literal] record
      case pointer_type: (proc_pointer, code_based_pointer) of
      = proc_pointer =
        procedure_pointer: ^procedure,
      = code_based_pointer =
        code_based_pointer: ^ost$external_code_base_pointer,
      casend,
    recend := [proc_pointer, ^pmp$call_ring_crossing_proc];

  VAR
    nil_pva: [STATIC, READ, oss$job_paged_literal] ost$pva :=
          [osc$max_ring, osc$maximum_segment, -(osc$maximum_offset + 1)],
    ring_0_or_access_violation: [STATIC, READ, oss$job_paged_literal] pmt$condition :=
          [pmc$system_conditions, $pmt$system_conditions [pmc$invalid_segment_ring_0,
          pmc$access_violation], *];

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

{ PURPOSE:
{   Appends the address as a new status field.

  PROCEDURE append_address_to_message
    (    address: ost$pva;
     VAR message {input, output} : ost$status);

    VAR
      text: ost$string;

    text.size := 0;
    append_pva_to_string (address, text);
    osp$append_status_parameter (osc$status_parameter_delimiter, text.value (1, text.size), message);
  PROCEND append_address_to_message;
?? OLDTITLE ??
?? NEWTITLE := 'append_pva_to_message', EJECT ??

{ PURPOSE:
{   Adds the pva to the message with the specified label.

  PROCEDURE append_pva_to_message
    (    label: string ( * <= 10);
         pva: ost$pva;
     VAR message {input, output} : ost$status);

    VAR
      text: ost$string;

    text.value := label;
    text.size := STRLENGTH (label) + 1;
    text.value (text.size) := '=';
    append_pva_to_string (pva, text);
    osp$append_status_parameter (' ', text.value (1, text.size), message);
  PROCEND append_pva_to_message;
?? OLDTITLE ??
?? NEWTITLE := 'append_pva_to_string', EJECT ??

{ PURPOSE:
{   Appends a PVA to a string.

  PROCEDURE append_pva_to_string
    (    pva: ost$pva;
     VAR str {input, output} : ost$string);

    VAR
      ignore_status: ost$status,
      text: ost$string;

    clp$convert_integer_to_string (pva.ring, 16, FALSE, text, ignore_status);
    str.value (str.size + 1, * ) := text.value (1, text.size);
    str.size := str.size + text.size;

    clp$convert_integer_to_string (pva.seg, 16, FALSE, text, ignore_status);
    str.value (str.size + 1, 1) := ' ';
    str.value (str.size + 2, * ) := text.value (1, text.size);
    str.size := str.size + text.size + 1;

    clp$convert_integer_to_string (pva.offset, 16, FALSE, text, ignore_status);
    str.value (str.size + 1, 1) := ' ';
    str.value (str.size + 2, * ) := text.value (1, text.size);
    str.size := str.size + text.size + 1;
  PROCEND append_pva_to_string;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] osp$format_segment_condition', EJECT ??
*copyc osh$format_segment_condition

  PROCEDURE [XDCL] osp$format_segment_condition
    (    identifier: string (2);
         segment_access_condition: mmt$segment_access_condition;
         save_area: ^ost$stack_frame_save_area;
     VAR message: ost$status;
     VAR status: ost$status);

?? NEWTITLE := 'dispose_of_sfsa_condition', EJECT ??

{ PURPOSE:
{   The purpose of this condition handler is to diagnose an erroneous
{   save_area parameter.

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

      osp$set_status_condition (ose$invalid_save_area, message);
      EXIT osp$format_segment_condition;
    PROCEND dispose_of_sfsa_condition;
?? OLDTITLE ??

    VAR
      descriptor: pmt$established_handler,
      error_pva: ost$pva,
      ignore_status: ost$status,
      this_is_a_stack: boolean;

    status.normal := TRUE;
    message.normal := TRUE;
    error_pva.ring := #RING (segment_access_condition.segment);
    error_pva.seg := #SEGMENT (segment_access_condition.segment);
    error_pva.offset := #OFFSET (segment_access_condition.segment);
    bap$format_segment_condition (identifier, segment_access_condition, save_area, error_pva, message);
    IF message.normal THEN

      CASE segment_access_condition.identifier OF
      = mmc$sac_io_read_error =
        osp$set_status_condition (mme$io_read_error, message);
      = mmc$sac_read_beyond_eoi =
        osp$set_status_condition (mme$read_beyond_eoi, message);
      = mmc$sac_read_write_beyond_msl =
        stack_segment (error_pva, this_is_a_stack);
        IF this_is_a_stack THEN
          osp$set_status_condition (mme$stack_overflow, message);
        ELSEIF scl_work_area_segment (error_pva) THEN
          osp$set_status_condition (cle$work_area_overflow, message);
        ELSE
          osp$set_status_condition (mme$read_write_beyond_msl, message);
        IFEND;
      = mmc$sac_segment_access_error =
        osp$set_status_condition (mme$segment_access_error, message);
      = mmc$sac_ring_violation =
        osp$set_status_condition (mme$ring_violation, message);
      = mmc$sac_no_append_permission =
        osp$set_status_condition (mme$write_beyond_eoi_no_append, message);
      = mmc$sac_file_server_terminated =
        osp$set_status_condition (mme$file_server_terminated, message);
      = mmc$sac_pf_space_limit_exceeded =
        osp$set_status_condition (mme$pf_space_limit_exceeded, message);
      = mmc$sac_tf_space_limit_exceeded =
        osp$set_status_condition (mme$tf_space_limit_exceeded, message);
      = mmc$sac_runaway_write =
        osp$set_status_condition (mme$runaway_write, message);
      ELSE
        osp$set_status_abnormal ('OS', ose$unknown_segment_condition, '', status);
        append_address_to_message (error_pva, status);
        append_address_to_message (save_area^.minimum_save_area.p_register.pva, status);
      CASEND;

      pmp$establish_condition_handler (ring_0_or_access_violation, ^dispose_of_sfsa_condition, ^descriptor,
            ignore_status);
      append_address_to_message (error_pva, message);
      resolve_p_address (save_area, message);
    IFEND;

  PROCEND osp$format_segment_condition;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] osp$format_system_condition', EJECT ??
*copyc osh$format_system_condition

  PROCEDURE [XDCL] osp$format_system_condition
    (    system_condition: pmt$system_condition;
         untranslatable_pointer: ost$pva;
         save_area: ^ost$stack_frame_save_area;
     VAR message: ost$status);

?? NEWTITLE := 'dispose_of_sfsa_condition', EJECT ??

{ PURPOSE:
{   The purpose of this condition handler is to diagnose an erroneous
{   save_area parameter.

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

      osp$set_status_condition (ose$invalid_save_area, message);
      EXIT osp$format_system_condition;
    PROCEND dispose_of_sfsa_condition;
?? OLDTITLE, EJECT ??

    CONST
      identifier = pmc$program_management_id;

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



    VAR
      descriptor: pmt$established_handler,
      ignore_status: ost$status,
      mainframe_id: pmt$binary_mainframe_id,
      op_code_pointer: ^op_code,
      p_address: ^cell,
      ring_0_utp: [STATIC, READ, oss$job_paged_literal] ost$pva :=
            [osc$default_utp_ring, osc$default_utp_segment, osc$default_utp_offset];

    pmp$establish_condition_handler (ring_0_or_access_violation, ^dispose_of_sfsa_condition, ^descriptor,
          ignore_status);

    CASE system_condition OF
    = pmc$detected_uncorrected_err =
      osp$set_status_abnormal (identifier, pme$system_condition, 'uncorrected mainframe hardware error',
            message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
      IF (untranslatable_pointer <> ring_0_utp) THEN
        append_pva_to_message ('PVA', untranslatable_pointer, message);
      IFEND;
    = pmc$ua_unselectable =
      osp$set_status_abnormal (identifier, pme$system_condition, 'not assigned', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$sw_unselectable =
      osp$set_status_abnormal (identifier, pme$system_condition, 'short warning', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$address_specification =
      osp$set_status_abnormal (identifier, pme$system_condition, 'address specification error', message);
      resolve_p_address (save_area, message);
      append_pva_to_message ('PVA', untranslatable_pointer, message);
    = pmc$xr_unselectable =
      osp$set_status_abnormal (identifier, pme$system_condition, 'C170 exchange request', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$access_violation =
      osp$set_status_abnormal (identifier, pme$system_condition, 'access violation', message);
      resolve_p_address (save_area, message);
      append_pva_to_message ('PVA', untranslatable_pointer, message);
    = pmc$instruction_specification =
      osp$set_status_abnormal (identifier, pme$system_condition, 'instruction specification error', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$environment_specification =
      osp$set_status_abnormal (identifier, pme$system_condition, 'environment specification error', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$xi_unselectable =
      osp$set_status_abnormal (identifier, pme$system_condition, 'external interrupt', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$pf_unselectable =
      osp$set_status_abnormal (identifier, pme$system_condition, 'page table search without find', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
      append_pva_to_message ('PVA', untranslatable_pointer, message);
    = pmc$sc_unselectable =
      osp$set_status_abnormal (identifier, pme$system_condition, 'system call', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$sit_unselectable =
      osp$set_status_abnormal (identifier, pme$system_condition, 'system interval timer', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$invalid_segment_ring_0 =
      IF (untranslatable_pointer = ring_0_utp) OR ((untranslatable_pointer.ring =
            llc$unlinked_pointer_ring) AND (untranslatable_pointer.seg = llc$unlinked_pointer_segment)) THEN
        osp$set_status_abnormal (identifier, pme$system_condition, 'ring number zero', message);
        append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
      ELSE
        osp$set_status_abnormal (identifier, pme$system_condition, 'invalid segment', message);
        resolve_p_address (save_area, message);
        append_pva_to_message ('PVA', untranslatable_pointer, message);
      IFEND;
    = pmc$out_call_in_return =
      osp$set_status_abnormal (identifier, pme$system_condition, 'outward call / inward return', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$sel_unselectable =
      osp$set_status_abnormal (identifier, pme$system_condition, 'soft error', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$tx_unselectable =
      osp$set_status_abnormal (identifier, pme$system_condition, 'trap exception', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$privileged_instruction =
      osp$set_status_abnormal (identifier, pme$system_condition, 'privileged instruction fault', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$unimplemented_instruction =
      p_address := #ADDRESS (save_area^.minimum_save_area.p_register.pva.ring,
            save_area^.minimum_save_area.p_register.pva.seg, save_area^.minimum_save_area.p_register.pva.
            offset);
      op_code_pointer := p_address;
      pmp$get_binary_mainframe_id (mainframe_id, ignore_status);
      IF (op_code_pointer^ >= 40(16)) AND (op_code_pointer^ <= 5E(16)) THEN
        osp$set_status_abnormal (identifier, pme$system_condition,
              'unimplemented instruction - vector instruction simulation is disabled', message);
      ELSE
        osp$set_status_abnormal (identifier, pme$system_condition, 'unimplemented instruction', message);
      IFEND;
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$ff_unselectable =
      osp$set_status_abnormal (identifier, pme$system_condition, 'free flag', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$pit_unselectable =
      osp$set_status_abnormal (identifier, pme$system_condition, 'process interval timer', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$inter_ring_pop =
      osp$set_status_abnormal (identifier, pme$system_condition, 'inter ring pop', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$cff_unselectable =
      osp$set_status_abnormal (identifier, pme$system_condition, 'critical frame flag', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$kypt_unselectable =
      osp$set_status_abnormal (identifier, pme$system_condition, 'keypoint', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$divide_fault =
      osp$set_status_abnormal (identifier, pme$system_condition, 'divide fault', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$debug_unselectable =
      osp$set_status_abnormal (identifier, pme$system_condition, 'debug', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$arithmetic_overflow =
      osp$set_status_abnormal (identifier, pme$system_condition, 'arithmetic overflow', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$exponent_overflow =
      osp$set_status_abnormal (identifier, pme$system_condition, 'exponent overflow', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$exponent_underflow =
      osp$set_status_abnormal (identifier, pme$system_condition, 'exponent underflow', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$fp_significance_loss =
      osp$set_status_abnormal (identifier, pme$system_condition, 'F. P. significance loss', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$fp_indefinite =
      osp$set_status_abnormal (identifier, pme$system_condition, 'F. P. indefinite', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$arithmetic_significance =
      osp$set_status_abnormal (identifier, pme$system_condition, 'arithmetic loss of significance', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    = pmc$invalid_bdp_data =
      osp$set_status_abnormal (identifier, pme$system_condition, 'invalid BDP data', message);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, message);
    CASEND;
  PROCEND osp$format_system_condition;
?? OLDTITLE ??
?? NEWTITLE := 'resolve_p_address', EJECT ??

{ PURPOSE:
{   An error has occurred which may be in the system code.  This routine needs
{   to append to the status message the location of the error and the location
{   in the user code which first entered the system code.  To assist in the
{   location of system failures, the p from the following frames will be
{   reported.
{      P of the failure.
{      Trace back of system calls:
{        P of the frame prior to the failure.
{        P of the first frame of each ring.
{        P of the first frame after the user frame.
{      P of the last user frame before system calls.
{

  PROCEDURE resolve_p_address
    (    condition_save_area: ^ost$stack_frame_save_area;
     VAR message: ost$status);


    VAR
      actual_p: ost$pva,
      newest_p: ost$pva,
      previous_p: ost$pva,
      ring_crossing_p: ost$pva,
      sfsa: ^ost$stack_frame_save_area,
      frame_count: integer,
      status: ost$status,
      str: ost$string;


    status.normal := TRUE;

    sfsa := condition_save_area;
    actual_p := sfsa^.minimum_save_area.p_register.pva;
    previous_p := actual_p;
    append_address_to_message (actual_p, message);

    str.value := 'TB=';
    str.size := 3;
    frame_count := 0;
    ring_crossing_p.offset := #OFFSET (ring_crossing_routine.code_based_pointer^.code_pva);
    ring_crossing_p.seg := #SEGMENT (ring_crossing_routine.code_based_pointer^.code_pva);
    ring_crossing_p.ring := previous_p.ring;

    pmp$validate_previous_save_area (sfsa, status);
    sfsa := sfsa^.minimum_save_area.a2_previous_save_area;

    WHILE (status.normal) AND (sfsa <> NIL) AND (previous_p.seg < mmc$first_loader_predefined_seg) DO
      newest_p := sfsa^.minimum_save_area.p_register.pva;
      IF newest_p <> ring_crossing_p THEN
        IF (previous_p.ring < newest_p.ring) OR ((newest_p.seg >= mmc$first_loader_predefined_seg)) OR
              (frame_count = 1) THEN
          IF frame_count > 0 THEN
            append_pva_to_string (previous_p, str);
            str.value (str.size + 1) := '/';
            str.size := str.size + 1;
          IFEND;
        IFEND;
        previous_p := newest_p;
        frame_count := frame_count + 1;
        ring_crossing_p.ring := previous_p.ring;
      IFEND;
      pmp$validate_previous_save_area (sfsa, status);
      sfsa := sfsa^.minimum_save_area.a2_previous_save_area;
    WHILEND;

    IF str.size > 3 THEN
      osp$append_status_parameter (' ', str.value (1, str.size - 1), message);
    IFEND;

    IF status.normal AND (frame_count > 0) AND (newest_p.seg >= mmc$first_loader_predefined_seg) THEN
      append_pva_to_message ('Users P', previous_p, message);
    IFEND;

  PROCEND resolve_p_address;
?? OLDTITLE, EJECT ??
?? NEWTITLE := '[XDCL, #GATE] osp$set_status_from_condition', EJECT ??
*copyc osh$set_status_from_condition

  PROCEDURE [XDCL, #GATE] osp$set_status_from_condition
    (    identifier: ost$status_identifier;
         condition: pmt$condition;
         save_area: ^ost$stack_frame_save_area;
     VAR condition_status: ost$status;
     VAR status: ost$status);

?? NEWTITLE := 'dispose_of_sfsa_condition', EJECT ??

{ PURPOSE:
{

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

{The purpose of this condition handler is to diagnose an erroneous save_area parameter.

      osp$set_status_condition (ose$invalid_save_area, status);
      EXIT osp$set_status_from_condition;

    PROCEND dispose_of_sfsa_condition;
?? OLDTITLE, EJECT ??

    VAR
      system_condition: pmt$system_condition,
      descriptor: pmt$established_handler,
      limit_name: ost$name,
      ignore_status: ost$status;

    status.normal := TRUE;
    pmp$establish_condition_handler (ring_0_or_access_violation, ^dispose_of_sfsa_condition, ^descriptor,
          ignore_status);
    CASE condition.selector OF
    = pmc$system_conditions =
      IF (condition.system_conditions <> $pmt$system_conditions []) THEN
        system_condition := pmc$detected_uncorrected_err;
        REPEAT
          IF NOT (system_condition IN condition.system_conditions) THEN
            system_condition := SUCC (system_condition);
          IFEND;
        UNTIL system_condition IN condition.system_conditions;
        osp$format_system_condition (system_condition, condition.untranslatable_pointer, save_area,
              condition_status);
      ELSE
        osp$set_status_condition (ose$empty_system_condition, status);
      IFEND;
    = pmc$block_exit_processing =
      IF (condition.reason <> $pmt$block_exit_reason []) THEN
        IF (pmc$block_exit IN condition.reason) THEN
          osp$set_status_abnormal (identifier, ose$condition_message_template, 'BLOCK EXIT - RETURN/POP',
                condition_status);
        ELSEIF (pmc$program_termination IN condition.reason) THEN
          osp$set_status_abnormal (identifier, ose$condition_message_template,
                'BLOCK EXIT - PROGRAM TERMINATION', condition_status);
        ELSEIF (pmc$program_abort IN condition.reason) THEN
          osp$set_status_abnormal (identifier, ose$condition_message_template, 'BLOCK EXIT - PROGRAM ABORT',
                condition_status);
        IFEND;
        osp$append_status_parameter (' ', 'AT P=', condition_status);
        append_address_to_message (save_area^.minimum_save_area.p_register.pva, condition_status);
      ELSE
        osp$set_status_condition (ose$empty_block_exit_reason, status);
      IFEND;
    = mmc$segment_access_condition =
      osp$format_segment_condition (identifier, condition.segment_access_condition, save_area,
            condition_status, status);
    = jmc$job_resource_condition =
      IF condition.job_resource_condition = jmc$time_limit_condition THEN
        osp$set_status_condition (jme$time_limit_condition, condition_status);
      ELSE
        sfp$get_job_limit_name (condition.job_resource_condition, limit_name, ignore_status);
        osp$set_status_abnormal (identifier, jme$resource_condition, limit_name, condition_status);
      IFEND;
    = pmc$user_defined_condition =
      osp$set_status_abnormal (identifier, ose$condition_message_template, 'USER DEFINED CONDITION: ',
            condition_status);
      osp$append_status_parameter (osc$status_parameter_delimiter, condition.user_condition_name,
            condition_status);
    = ifc$interactive_condition =
      CASE condition.interactive_condition OF
      = ifc$pause_break =
        osp$set_status_condition (ife$pause_break, condition_status);
      = ifc$terminate_break =
        osp$set_status_condition (ife$terminate_break, condition_status);
      = ifc$terminal_connection_broken =
        osp$set_status_condition (ife$terminal_connection_broken, condition_status);
      = ifc$job_reconnect =
        osp$set_status_condition (ife$job_reconnect, condition_status);
      ELSE
        osp$set_status_condition (ose$unknown_interactive_cond, status);
      CASEND;
    = pmc$pit_condition =
      osp$set_status_abnormal (identifier, ose$condition_message_template, 'PROCESS INTERVAL TIMER',
            condition_status);
      osp$append_status_parameter (' ', 'AT P=', condition_status);
      append_address_to_message (save_area^.minimum_save_area.p_register.pva, condition_status);
    ELSE
      osp$set_status_condition (ose$invalid_condition_selector, status);
    CASEND;

  PROCEND osp$set_status_from_condition;
?? OLDTITLE ??
?? NEWTITLE := 'stack_segment', EJECT ??

{ PURPOSE:
{   Check if the pva is in a stack segment.

  PROCEDURE stack_segment
    (    pva: ost$pva;
     VAR stack: boolean);


    VAR
      attribute: array [1 .. 1] of mmt$attribute_descriptor,
      local_status: ost$status;


    attribute [1].keyword := mmc$kw_software_attributes;
    mmp$fetch_segment_attributes (#ADDRESS (pva.ring, pva.seg, 0), attribute, local_status);

    stack := ((local_status.normal) AND (mmc$sa_stack IN attribute [1].software_attri_set));

  PROCEND stack_segment;
?? OLDTITLE ??
?? NEWTITLE := 'scl_work_area_segment', EJECT ??

{ PURPOSE:
{   Check if the pva is in an SCL work area segment.

  FUNCTION [INLINE] scl_work_area_segment
    (    pva: ost$pva): boolean;

    VAR
      ring: ost$ring;


    FOR ring := LOWERBOUND (clv$work_areas) TO UPPERBOUND (clv$work_areas) DO
      IF (clv$work_areas [ring].breakdown <> NIL) AND
            (pva.seg = #SEGMENT (clv$work_areas [ring].breakdown^.pva)) THEN

        scl_work_area_segment := TRUE;
        RETURN;

      IFEND;
    FOREND;

    scl_work_area_segment := FALSE;

  FUNCEND scl_work_area_segment;
?? OLDTITLE ??

MODEND osm$set_status_from_condition;
