?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE: Program Control - Program Conditions' ??
?? NEWTITLE := '  Global System Declarations' ??
MODULE pmm$manage_condition_stacks_r2;


{   PURPOSE:
{     The purpose of this module is to confine access to the
{     condition environment stack int the task_control_block.
{     All accesses to this stack are via procedures in this module.

{   DESIGN:
{     This module is designed to execute in ring 2. This is necessary to
{     handle ring 2 conditions (ie. interactive).
?? EJECT ??
*copyc OSP$SET_STATUS_ABNORMAL
*copyc oss$job_paged_literal
*copyc OST$CALLER_IDENTIFIER
*copyc OST$STACK_FRAME_SAVE_AREA
*copyc OST$STATUS
*copyc PMC$PROGRAM_MANAGEMENT_ID
*copyc PMP$ESTABLISH_CONDITION_HANDLER
*copyc pmp$find_executing_task_tcb
*copyc PMT$CONDITION
*copyc PMT$CONDITION_ENVIRONMENT
*copyc PMT$ESTABLISHED_HANDLER

  TYPE
    comparable_pointer = 0 .. 0ffffffffffff(16);

  VAR
    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], * ];


?? NEWTITLE := '  [XDCL, #GATE] pmp$post_current_environment_r2' ??
?? EJECT ??


  PROCEDURE [XDCL, #GATE] pmp$post_current_environment_r2
    (    condition_ring: ost$ring;
     VAR environment: ^pmt$condition_environment);

    VAR
      tcb: ^pmt$task_control_block;

    pmp$find_executing_task_tcb (tcb);

    {push the environment onto the condition_environment_stack}

    environment^.next_environment := tcb^.condition_environment_stack;
    tcb^.condition_environment_stack := #ADDRESS (condition_ring, #SEGMENT (environment),
          #OFFSET (environment));

  PROCEND pmp$post_current_environment_r2;
?? TITLE := '  [XDCL, #GATE] pmp$delete_current_environ_r2 ' ??
?? EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$delete_current_environ_r2
    (    condition_ring: ost$ring;
     VAR status: ost$status);

    {The purpose of this procedure is to pop the current environment from the
    { condition_environment_stack

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

{        PURPOSE:
{          This procedure ensures that if the environment in the calling
{          stack segment has been overwritten, that the condition environment
{          stack is truncated - allowing further condition processing.


      VAR
        environment_stack: ^pmt$condition_environment,
        tcb: ^pmt$task_control_block;

      pmp$find_executing_task_tcb (tcb);

      environment_stack := #address (#ring(tcb^.condition_environment_stack), #segment
            (tcb^.condition_environment_stack), #offset (tcb^.condition_environment_stack));
      {The environment at top of stack is the environment of this condition handler - next_environment is the
      {faultly environment.
      environment_stack^.next_environment := NIL;
      osp$set_status_abnormal (pmc$program_management_id, pme$stack_overwritten, '', status);
      EXIT pmp$delete_current_environ_r2;
    PROCEND dispose_of_environment_overwrit;

?? EJECT ??
    VAR
      descriptor: pmt$established_handler,
      environment_stack: ^pmt$condition_environment,
      ignore_status: ost$status,
      tcb: ^pmt$task_control_block;

    status.normal := TRUE;
    pmp$establish_condition_handler (environment_overwrite, ^dispose_of_environment_overwrit, ^descriptor,
          ignore_status);

    pmp$find_executing_task_tcb (tcb);

    environment_stack := #ADDRESS (condition_ring,
          #SEGMENT (tcb^.condition_environment_stack),
          #OFFSET (tcb^.condition_environment_stack));
    tcb^.condition_environment_stack := environment_stack^.next_environment;

  PROCEND pmp$delete_current_environ_r2;
?? TITLE := '  [XDCL, #GATE] pmp$get_current_environ_r2 ' ??
?? EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$get_current_environ_r2
    (   condition_ring: ost$ring;
     VAR environment: pmt$condition_environment;
     VAR environment_present: boolean;
     VAR status: ost$status);

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

{        PURPOSE:
{          This procedure ensures that if the environment in the calling
{          stack segment has been overwritten, that the condition environment
{          stack is truncated - allowing further condition processing.

      VAR
        tcb: ^pmt$task_control_block;

      pmp$find_executing_task_tcb (tcb);

      {The environment at top of stack is the environment of this condition handler - next_environment is the
      {faultly environment.
      tcb^.condition_environment_stack^.next_environment := NIL;
      osp$set_status_abnormal (pmc$program_management_id, pme$stack_overwritten, '', status);
      environment_present := FALSE;
      EXIT pmp$get_current_environ_r2;
    PROCEND dispose_of_environment_overwrit;
?? EJECT ??
    VAR
      descriptor: pmt$established_handler,
      environment_stack: ^pmt$condition_environment,
      ignore_status: ost$status,
      tcb: ^pmt$task_control_block;

    status.normal := TRUE;
    pmp$establish_condition_handler (environment_overwrite, ^dispose_of_environment_overwrit, ^descriptor,
          ignore_status);

    pmp$find_executing_task_tcb (tcb);

    IF (tcb^.condition_environment_stack <> NIL) THEN
      IF (#RING (tcb^.condition_environment_stack) = condition_ring) THEN
        IF (#SEGMENT (tcb^.condition_environment_stack) = #SEGMENT (^environment)) THEN
          environment_stack := #ADDRESS (condition_ring, #SEGMENT (tcb^.condition_environment_stack),
                #OFFSET (tcb^.condition_environment_stack));
          environment := environment_stack^;
          environment_present := TRUE;
        ELSE
          {An environment was previously overwritten - there is no condition to continue, the environment
          {stack is truncated.
          environment_present := FALSE;
          tcb^.condition_environment_stack := NIL;
        IFEND;
      ELSEIF (#RING (tcb^.condition_environment_stack) > condition_ring) THEN
        {The environment at top of stack is from a higher ring - there is no condition to continue. Either the
        {condition arose in higher ring; or the previous execution of a condition handler in a higher ring
        {performed a nonlocal exit by modifying its own A2; or an environment was previously overwritten - a
        {judgement cannot be made at this point.
        environment_present := FALSE;
      ELSE
        {An environment was previously overwritten or the previous execution of a condition handler in a lower
        {ring performed a nonlocal exit by modifying its own A2 - the environment stack is truncated; there is
        {no condition to continue.
        environment_present := FALSE;
        tcb^.condition_environment_stack := NIL;
      IFEND;
    ELSE
      environment_present := FALSE;
    IFEND;

  PROCEND pmp$get_current_environ_r2;
?? TITLE := '  [XDCL, #GATE] pmp$delete_environment_r2' ??
?? EJECT ??

  PROCEDURE [XDCL, #GATE] pmp$delete_environment_r2
    (    condition_ring: ost$ring;
         critical_frame: ^ost$stack_frame_save_area;
     VAR status: ost$status);

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

      VAR
        tcb: ^pmt$task_control_block;

{        PURPOSE:
{          This procedure ensures that if an environment in the calling
{          stack segment has been overwritten, that the condition environment
{          stack is truncated - allowing further condition processing.

      pmp$find_executing_task_tcb (tcb);

      IF (relink = ^tcb^.condition_environment_stack) THEN
        {The environment formerly at the top of stack has been overwritten. The environment at top of stack is
        {the environment of this condition handler - next_environment is the faultly environment.
        relink^^.next_environment := NIL;
      ELSE
        {An environment at other than top of stack has been overwritten.
        relink^ := NIL;
      IFEND;
      osp$set_status_abnormal (pmc$program_management_id, pme$stack_overwritten, '', status);
      EXIT pmp$delete_environment_r2;
    PROCEND dispose_of_environment_overwrit;


    VAR
      converter: record
        case 0 .. 1 of
        = 0 =
          cell_pointer: ^cell,
        = 1 =
          comparable_pointer: comparable_pointer,
        casend,
      recend,

      descriptor: pmt$established_handler,
      deleted: boolean,
      scan_environment: ^pmt$condition_environment,
      relink: ^^pmt$condition_environment,
      environment_stack: ^pmt$condition_environment,

      end_of_frame: comparable_pointer,
      start_of_frame: comparable_pointer,
      scan: comparable_pointer,
      tcb: ^pmt$task_control_block,
      ignore_status: ost$status;

    status.normal := TRUE;

    pmp$find_executing_task_tcb (tcb);

    relink := ^tcb^.condition_environment_stack; { this assignment is needed for the condition handler }
    pmp$establish_condition_handler (environment_overwrite, ^dispose_of_environment_overwrit, ^descriptor,
          ignore_status);


    environment_stack := #ADDRESS (condition_ring, #SEGMENT (tcb^.condition_environment_stack),
          #OFFSET (tcb^.condition_environment_stack));
    converter.cell_pointer := critical_frame;
    end_of_frame := converter.comparable_pointer;
    converter.cell_pointer := critical_frame^.minimum_save_area.a1_current_stack_frame;
    start_of_frame := converter.comparable_pointer;
    scan_environment := environment_stack^.next_environment;
    relink := ^environment_stack^.next_environment;
    deleted := FALSE;
    {find the environment associated with the critical *frame}
    WHILE NOT deleted AND (scan_environment <> NIL) DO
      converter.cell_pointer := scan_environment;
      scan := converter.comparable_pointer;
      IF (scan < end_of_frame) AND (scan > start_of_frame) THEN
        {delete the condition environment from the environment stack}
        relink^ := scan_environment^.next_environment;
        deleted := TRUE;
      ELSE
        scan_environment := scan_environment^.next_environment;
        relink := ^relink^^.next_environment;
      IFEND;
    WHILEND;
  PROCEND pmp$delete_environment_r2;

MODEND pmm$manage_condition_stacks_r2;
