*DECK C$PERF
          IDENT  C$PERF 
 CBPERF   TITLE  CBPERF - PROCESS PERFORM STACK 
  
          MACHINE  ANY,I
          COMMENT  PROCESS PERFORM STACK
          SST 
          B1=1
          SPACE  4
**     CBPERF - PROCESS PERFORM STACK.
* 
*      CALLING SEQUENCE:  
* 
*         SB3    END-ADR
*         SB4    RET-ADR OR ZERO
*         RJ     C.PERF 
* 
*         WHERE  END-ADR = ADDRESS OF WORD AT END OF PERFORM RANGE
*                          WHERE A JUMP GETS PLANTED. 
*                          FOR SEGMENTED RUNS, IT IS THE ADDRESS OF THE 
*                          EXIT-INDEX ASSOCIATED WITH THE PERFORM RANGE.
*                RET-ADR = NZ IF THE PERFORM RANGE ENDING AT THE
*                             LOCATION SPECIFIED BY END-ADR IS TO BE
*                             ACTIVATED.  RET-ADR IS THE ADDRESS FOR THE
*                             PLANTED JUMP TO RETURN.  FOR SEGMENTED
*                             RUNS, IT IS THE ADDRESS OF THE RETURN-
*                             INDEX TO BE STORED IN THE EXIT-INDEX. 
*                          ZR IF THE PERFORM RANGE ENDING AT THE
*                             LOCATION SPECIFIED BY END-ADR IS TO BE
*                             DE-ACTIVATED. 
* 
*      DOES:  
* 
*         ACTIVATING A PERFORM: 
* 
*            FOR NON-SEGMENTED RUNS:  
* 
*                THE CONTENTS OF END-ADR (EITHER A JUMP TO *+1 OR A 
*         JUMP OUT OF A CURRENTLY-ACTIVE PERFORM RANGE) IS ADDED TO THE 
*         TOP OF THE STACK OF ENTRIES FOR END-ADR.  A JUMP TO RET-ADR 
*         IS THEN STORED AT END-ADR.  THE COMMON MEMORY MANAGER IS
*         CALLED AS NECESSARY TO GET MORE SPACE FOR THE STACK.
* 
*            FOR SEGMENTED RUNS:  
* 
*                SAME AS ABOVE, EXCEPT A JUMP INSTRUCTION IS NOT
*         FORMED.  THE CONTENTS OF *RET-ADR* ARE MERELY MOVED TO
*         *END-ADR*.
* 
*         DE-ACTIVATING A PERFORM:  
* 
*                THE TOP ENTRY OF THE STACK FOR END-ADR IS POPPED 
*         (REMOVED) FROM THE STACK AND IS STORED AT END-ADR.
* 
*         FORMAT OF A PERFORM STACK:  
* 
*         TWO WORDS FOR EACH ACTIVE PERFORM 
*                VFD    30/LINE,30/END-ADR
*                VFD    60/EXIT 
* 
*                WHERE  LINE - LINE NUMBER OF PERFORM 
*                       END-ADR - AS ABOVE
*                       EXIT - CONTENTS OF END-ADR
* 
*      USES:  
* 
*         ALL REGISTERS EXCEPT B1.
  
          ENTRY  C.PERFS
 C.PERFS  BSS    0
  
          ENTRY  C.PERF 
 C.PERF   DATA   0           ENTRY / EXIT 
  
 DEBUGC   IFNE   DEBUGC,0    ASSEMBLE ONLY IF DEBUG COMPILER
          SB0    B1+TRAKON   JUMP IF TRACKING 
 PRF000   BSS    0
 DEBUGC   ENDIF 
  
          ZR     B4,PRF30    IF TO DE-ACTIVATE PERFORM
  
*      ACTIVATE.
  
          SA1    SF 
          NZ     X1,PRF3     NOT FIRST TIME 
          SX6    B3 
          SA6    RTEMP
          SX6    B4 
          SA6    A6+B1
          SB5    A1          POINTER WORD 
          SB6    INCR        SIZE 
          SB7    B1+B1       VARYING
          RJ     =XC.GETBK
          EQ     PRF4 
          SPACE  3
 PRF3     SA2    PTR
          AX1    30          LENGTH 
          SX6    X2+2 
          IX3    X6-X1
          NZ     X3,PRF5     STACK NOT FULL 
          SX6    B3 
          SA6    RTEMP
          SX6    B4 
          SA6    A6+B1
          SB6    A1 
          SB7    INCR 
          RJ     =XC.GROWB
 PRF4     SA1    RTEMP
          SB3    X1 
          SA2    A1+B1
          SB4    X2 
 PRF5     SA1    SF 
          SA2    PTR
          SB5    X2 
          SX6    X2+2 
          SA6    A2 
          SA5    C.PERF 
          AX5    30 
          SA4    X5-1        LINE NUMBER
          SX4    X4 
          LX4    30 
          SX7    B3          END-ADR
          BX7    X4+X7
          SA7    X1+B5
          SA4    B3          SAVE EXIT INDEX
          BX7    X4 
          SA7    A7+B1
          SA1    B4          REPLACE EXIT INDEX 
          BX7    X1 
          SA7    B3 
          RJ     PRF99        CLEAR STACK FOR 855 
          SPACE  3
*      DEACTIVATE 
 PRF30    SA1    SF 
          SA2    PTR
          SX6    X2-2 
          SA6    A2 
          NG     X6,*+400000B      ERROR
          SB5    X1 
          SA3    B5+X6
          SB4    X3 
          NE     B3,B4,PRF60 PERFORMS EXITED OUT OF ORDER 
          SA3    A3+B1       RESTORE EXIT INDEX 
          BX7    X3 
          SA7    B3 
          RJ     PRF99        CLEAR STACK FOR 855 
  
 PRF99    BSS    0
 PRF99    DATA   0
  
 DEBUGC   IFNE   DEBUGC,0    ASSEMBLE ONLY IF DEBUG COMPILER
          SA2    TRAKFLG
          ZR     X2,C.PERF   RETURN IF NOT TRACKING ON ENTRY
          MX6    0           CLEAR TRACKING FLAG
          SA6    A2 
          RJ     =XTRACK     TURN TRACK BACK ON WITH PARAMETERS RESTORED
          CON    4LASIS,-0
          EQ     C.PERF      RETURN 
          ELSE
          EQ     C.PERF 
 DEBUGC   ENDIF 
  
 DEBUGC   IFNE   DEBUGC,0    ASSEMBLE ONLY IF DEBUG COMPILER
  
*      STOP TRACKING WHILE IN THIS ROUTINE. 
  
 TRAKON   RJ     =XUNTRACK   TURN TRACKING OFF
          SX6    B1          SET TRACKING FLAG
          SA6    TRAKFLG
          EQ     PRF000 
  
 TRAKFLG  CON    0           SET NZ IF TRACKING ON ENTRY
 DEBUGC   ENDIF 
 GETHDR   SPACE  4,10 
 PRF60    AX3    30 
          SX6    X3 
          SA6    LINE 
          MX2    0           NO INSERTS 
          SX1    #PRFMSG
          SX3    A6 
          SX7    B3 
          SA7    SAVEB3 
          MX6    0           RETURN 
          RJ     =XC.MSG
          SA1    SAVEB3 
          SB3    X1 
          EQ    PRF30        TRY AGAIN
 STORAGE  SPACE  4,10 
*      TEMPORARIES, ETC.
  
 SF       CON    0           FWA OF STACK 
 RTEMP    CON    0,0         REGISTER SAVE AREA 
 LINE     DATA   0
 PTR      DATA   0
 INCR     EQU    20B         AMOUNT TO INCREASE SIZE OF STACK 
 SAVEB3   BSS    1
  
          END 
