*DECK MANAGER 
         PROC MANAGER;
*CALL PPCOMMON2 
*CALL DPPPDDATA 
         BEGIN
         ITEM GROUPNUMBER;
         ITEM PP1MAX; 
         ITEM PP2MAX; 
         ITEM PP3MAX; 
         ITEM PP4MAX; 
         ITEM PP5MAX; 
         ITEM PP6MAX; 
         ITEM PP7MAX; 
         ITEM W1; 
         XREF FUNC CMM$ALV; 
         XREF FUNC CMM$AGR; 
         XREF PROC CMM$FGR; 
         XREF PROC CMM$GLV; 
         BASED ARRAY PP1 [0] S(1);
         BEGIN
         ITEM $STACK         U(00,00,60); 
         ITEM $TCODE         U(00,30,06); 
         ITEM $TPOINTER      U(00,36,15); 
         ITEM $TSUBCODE      U(00,51,09); 
         END
         BASED ARRAY PP2 [0] S(1);
         BEGIN
         ITEM $LINE          U(00,00,16); 
         ITEM $COLUMN        U(00,16,14); 
         ITEM $BOOLSTACK     U(00,30,30); 
         END
         BASED ARRAY PP3 [0] S(1);
         BEGIN
         ITEM $SUBJECT       U(00,00,30); 
         ITEM $OBJECT        U(00,30,30); 
         END
         BASED ARRAY PP4 [0] S(1);
         BEGIN
         ITEM $FORMULA       U(00,00,30); 
         ITEM $COMMONSTACK   U(00,30,30); 
         END
         BASED ARRAY PP5 [0] S(1);
         BEGIN
         ITEM $ADDRESS       I(00,00,20); 
         ITEM $PRIORITY      U(00,20,10); 
         ITEM $DBUGELEMENT   U(00,30,30); 
         END
         BASED ARRAY PP6 [0] S(2);
           BEGIN
             ITEM $ENDADDRESS I(0,0,20);
             ITEM $IMPFLG     I(0,20,10); 
             ITEM $NSFLAG     I(0,30,5);
             ITEM $NEXT       I(0,35,5);
             ITEM $EXTRA      I(0,40,20); 
             ITEM $VERBLINE   U(1,0,30);
             ITEM $VERBCOL    U(1,30,30); 
           END
         BASED ARRAY PP7 [0] S(1);
           BEGIN
             ITEM STK$ELEMENT U(0,0,60);
           END
         $BEGIN 
         XREF FUNC DEC       C(10);    # BINARY TO DISPLAY             #
         XREF FUNC OCT       C(40);    # BINARY TO OCTAL DISPLAY CODE  #
         XREF PROC OUTPUT;             # PRINT ON OUTPUT LISTING       #
         XREF PROC CBLIST;             # LISTING ROUTINE               #
         XREF ITEM BOOL$STK$TRC   B;   # BOOLEAN STACK TRACE           #
         XREF ITEM DBUG$STK$TRC   B;   # DEBUG STACK TRACE             #
         XREF ITEM FORM$STK$TRC   B;   # FORMULA STACK TRACE           #
         XREF ITEM PRI$STK$TRC    B;   # PRIORITY STACK TRACE          #
         XREF ITEM STACK$TRACE    B;   # MAIN STACK TRACE              #
         XREF ITEM SUB$OBJ$TRC    B;   # SUBJECT/OBJECT STACK TRACE    #
         ITEM LINE$$       C(50); 
         ITEM TEMP$        C(10); 
*CALL LISTCTL 
         CONTROL EJECT; 
         XDEF PROC STACKDMP;
         PROC STACKDMP; 
         BEGIN
         ITEM HEADER  C(40)="   $TCODE $TPOINTER $TSUBCODE $STACK    "; 
         ITEM I;
         LINE$$ = " ";
         IF S LS 0 THEN 
             BEGIN
             OUTPUT(2," STACKDMP "," S < 0    "); 
             RETURN;
             END
         OUTPUT(4,"      S = ",DEC(S),"     S$ = ",DEC(S$));
         CBLIST(LISTCTL"LINE",HEADER,40); 
         FOR I = S STEP -1 UNTIL 0 DO 
             BEGIN
             C<1,2>LINE$$ = DEC(I); 
             C<5,6>LINE$$ = OCT($TCODE[I],18,2);
             C<12,8>LINE$$ = OCT($TPOINTER[I],15,5);
             C<22,8>LINE$$ = OCT($TSUBCODE[I],17,3);
             C<30,20>LINE$$ = OCT($STACK[I],0,20);
             CBLIST(LISTCTL"LINE",LINE$$,50); 
             END
         RETURN;
         END
  
  
         XDEF PROC SUB$DMP; 
         PROC SUB$DMP;
         BEGIN
         IF SLENGTH LS 0 THEN 
             OUTPUT(3," SUBJECT D","UMP - SLEN","GTH < 0   ");
         ELSE 
             BEGIN
             LINE$$ = " ";
             OUTPUT(4," SUBJECT D","UMP - SLEN","GTH =     ", 
                      DEC(SLENGTH));
             FOR I = SLENGTH STEP -1 UNTIL 0 DO 
                 BEGIN
                 C<5,3>LINE$$ = DEC(I); 
                 C<10,10>LINE$$ = OCT($SUBJECT[I],10,10); 
                 CBLIST(LISTCTL"LINE",LINE$$,20); 
                 END
             END
         RETURN;
         END
  
  
         XDEF PROC OBJ$DMP; 
         PROC OBJ$DMP;
         BEGIN
         IF OLENGTH LS 0 THEN 
             OUTPUT(4," OBJECT DU","MP - OLENG","TH < 0    ");
         ELSE 
             BEGIN
             LINE$$ = " ";
             OUTPUT(3," OBJECT DU","MP - OLENG","TH =      ", 
                      DEC(OLENGTH));
             FOR I = OLENGTH STEP -1 UNTIL 0 DO 
                 BEGIN
                 LINE$$ = " ";
                 C<5,3>LINE$$ = DEC(I); 
                 C<10,10>LINE$$ = OCT($SUBJECT[I],10,10); 
                 CBLIST(LISTCTL"LINE",LINE$$,20); 
                 END
             END
         RETURN;
         END
         $END 
         CONTROL EJECT; 
         PROC GROW1;
         BEGIN
         CMM$GLV(PP1,20); 
         PP1MAX = PP1MAX + 20;
         END
         PROC GROW2;
         BEGIN
         CMM$GLV(PP2,20); 
         PP2MAX = PP2MAX + 20;
         END
         PROC GROW3;
         BEGIN
         CMM$GLV(PP3,20); 
         PP3MAX = PP3MAX + 20;
         END
         PROC GROW4;
         BEGIN
         CMM$GLV(PP4,20); 
         PP4MAX = PP4MAX + 20;
         END
         PROC GROW5;
         BEGIN
         CMM$GLV(PP5,20); 
         PP5MAX = PP5MAX + 20;
         END
         PROC GROW6;
           BEGIN
             CMM$GLV(PP6,20); 
             PP6MAX = PP6MAX + 10;
           END
         PROC GROW7;
           BEGIN
             CMM$GLV (PP7, 20); 
             PP7MAX = PP7MAX + 20;
           END
         XDEF PROC INITMGR; 
         PROC INITMGR;
         BEGIN
         PP1MAX = 19; 
         PP2MAX = 19; 
         PP3MAX = 19; 
         PP4MAX = 19; 
         PP5MAX = 19; 
         PP6MAX = 9;
         PP7MAX = 19; 
         GROUPNUMBER = CMM$AGR(0);
         W1 = CMM$ALV(20,1,3,GROUPNUMBER,P<PP1>,0); 
         W1 = CMM$ALV(20,1,3,GROUPNUMBER,P<PP2>,0); 
         W1 = CMM$ALV(20,1,3,GROUPNUMBER,P<PP3>,0); 
         W1 = CMM$ALV(20,1,3,GROUPNUMBER,P<PP4>,0); 
         W1 = CMM$ALV(20,1,3,GROUPNUMBER,P<PP5>,0); 
         W1 = CMM$ALV(20,1,3,GROUPNUMBER,P<PP6>,0); 
         W1 = CMM$ALV(20,1,3,GROUPNUMBER,P<PP7>,0); 
         END
         XDEF PROC KILLMGR; 
         PROC KILLMGR;
         BEGIN
         CMM$FGR(GROUPNUMBER);
         END
         XDEF FUNC STACK U; 
         FUNC STACK (P1) U; 
         BEGIN
         ITEM P1; 
         STACK = $STACK [P1]; 
         $BEGIN 
         IF STACK$TRACE THEN
             OUTPUT(3,"   $STACK ",DEC(P1),"REFERENCED"); 
         $END 
         END
         XDEF FUNC TCODE U; 
         FUNC TCODE (P1) U; 
         BEGIN
         ITEM P1; 
         TCODE = $TCODE [P1]; 
         $BEGIN 
         IF STACK$TRACE THEN
             OUTPUT(3,"   $TCODE ",DEC(P1),"REFERENCED"); 
         $END 
         END
         XDEF FUNC TPOINTER U;
         FUNC TPOINTER (P1) U;
         BEGIN
         ITEM P1; 
         TPOINTER = $TPOINTER [P1]; 
         $BEGIN 
         IF STACK$TRACE THEN
             OUTPUT(4,"       $TP","OINTER    ",DEC(P1),"REFERENCED");
         $END 
         END
         XDEF FUNC TSUBCODE U;
         FUNC TSUBCODE (P1) U;
         BEGIN
         ITEM P1; 
         TSUBCODE = $TSUBCODE [P1]; 
         $BEGIN 
         IF STACK$TRACE THEN
             OUTPUT(4,"       $TS","UBCODE    ",DEC(P1),"REFERENCED");
         $END 
         END
         XDEF FUNC LINE U;
         FUNC LINE (P1) U;
         BEGIN
         ITEM P1; 
         LINE = $LINE [P1]; 
         END
         XDEF FUNC COLUMN U;
         FUNC COLUMN (P1) U;
         BEGIN
         ITEM P1; 
         COLUMN = $COLUMN [P1]; 
         END
         XDEF FUNC BOOLSTACK U; 
         FUNC BOOLSTACK (P1) U; 
         BEGIN
         ITEM P1; 
         BOOLSTACK = $BOOLSTACK [P1]; 
         END
         XDEF FUNC SUBJECT U; 
         FUNC SUBJECT (P1) U; 
         BEGIN
         ITEM P1; 
         SUBJECT = $SUBJECT [P1]; 
         END
         XDEF FUNC OBJECT U;
         FUNC OBJECT (P1) U;
         BEGIN
         ITEM P1; 
         OBJECT = $OBJECT [P1]; 
         END
         XDEF FUNC FORMULA U; 
         FUNC FORMULA (P1) U; 
         BEGIN
         ITEM P1; 
         FORMULA = $FORMULA [P1]; 
         END
         XDEF FUNC COMMONSTACK U; 
         FUNC COMMONSTACK (P1) U; 
         BEGIN
         ITEM P1; 
         COMMONSTACK = $COMMONSTACK [P1]; 
         END
         XDEF FUNC ADDRESS U; 
         FUNC ADDRESS (P1) U; 
         BEGIN
         ITEM P1; 
         ADDRESS = $ADDRESS [P1]; 
         END
         XDEF FUNC PRIORITY U;
         FUNC PRIORITY (P1) U;
         BEGIN
         ITEM P1; 
         PRIORITY = $PRIORITY [P1]; 
         END
         XDEF FUNC DEBUGELEMENT U;
         FUNC DEBUGELEMENT (P1) U;
         BEGIN
         ITEM P1; 
         DEBUGELEMENT = $DBUGELEMENT [P1];
         $BEGIN 
         IF DBUG$STK$TRC THEN 
             OUTPUT(4,"    DEBUGE","LEMENT    ",DEC(P1),"REFERENCED");
         $END 
         END
         XDEF PROC XSTACK;
         PROC XSTACK (P1,P2); 
         BEGIN
         ITEM P1, P2; 
         L1:  
         IF P1 GR PP1MAX
         THEN BEGIN 
              GROW1;
              GOTO L1;
              END 
         $STACK [P1] = P2;
         $BEGIN 
         IF STACK$TRACE THEN
             BEGIN
             OUTPUT(3,"     XSTAC","K   AT    ",DEC(P1)); 
             STACKDMP;
             END
         $END 
         END
         XDEF PROC XTCODE;
         PROC XTCODE (P1,P2); 
         BEGIN
         ITEM P1, P2; 
         L2:  
         IF P1 GR PP1MAX
         THEN BEGIN 
              GROW1;
              GOTO L2;
              END 
         $TCODE [P1] = P2;
         $BEGIN 
         IF STACK$TRACE THEN
             BEGIN
             OUTPUT(3,"     XTCOD","E   AT    ",DEC(P1)); 
             STACKDMP;
             END
         $END 
         END
         XDEF PROC XTPOINTER; 
         PROC XTPOINTER (P1,P2);
         BEGIN
         ITEM P1, P2; 
         L3:  
         IF P1 GR PP1MAX
         THEN BEGIN 
              GROW1;
              GOTO L3;
              END 
         $TPOINTER [P1] = P2; 
         $BEGIN 
         IF STACK$TRACE THEN
             BEGIN
             OUTPUT(3,"     XTPOI","NTER  AT  ",DEC(P1)); 
             STACKDMP;
             END
         $END 
         END
         XDEF PROC XTSUBCODE; 
         PROC XTSUBCODE (P1,P2);
         BEGIN
         ITEM P1, P2; 
         L4:  
         IF P1 GR PP1MAX
         THEN BEGIN 
              GROW1;
              GOTO L4;
              END 
         $TSUBCODE [P1] = P2; 
         $BEGIN 
         IF STACK$TRACE THEN
             BEGIN
             OUTPUT(3,"     XTSUB","CODE  AT  ",DEC(P1)); 
             STACKDMP;
             END
         $END 
         END
         XDEF PROC XLINE; 
         PROC XLINE (P1,P2);
         BEGIN
         ITEM P1, P2; 
         L5:  
         IF P1 GR PP2MAX
         THEN BEGIN 
              GROW2;
              GOTO L5;
              END 
         $LINE [P1] = P2; 
         END
         XDEF PROC XCOLUMN; 
         PROC XCOLUMN (P1,P2);
         BEGIN
         ITEM P1, P2; 
         L6:  
         IF P1 GR PP2MAX
         THEN BEGIN 
              GROW2;
              GOTO L6;
              END 
         $COLUMN [P1] = P2; 
         END
         XDEF PROC XBOOLSTACK;
         PROC XBOOLSTACK (P1,P2); 
         BEGIN
         ITEM P1, P2; 
         L16: 
         IF P1 GR PP2MAX
         THEN BEGIN 
              GROW2;
              GOTO L16; 
              END 
         $BOOLSTACK [P1] = P2;
         $BEGIN 
         IF BOOL$STK$TRC THEN 
             BEGIN
             TEMP$ = OCT(P2,10,10); 
             OUTPUT(5,"     BOOLE","ANSTACK   ",DEC(P1),"    IS    ", 
                 TEMP$);
             END
         $END 
         END
         XDEF PROC XSUBJECT;
         PROC XSUBJECT (P1,P2); 
         BEGIN
         ITEM P1, P2; 
         L7:  
         IF P1 GR PP3MAX
         THEN BEGIN 
              GROW3;
              GOTO L7;
              END 
         $SUBJECT [P1] = P2;
         END
         XDEF PROC XOBJECT; 
         PROC XOBJECT (P1,P2);
         BEGIN
         ITEM P1, P2; 
         L8:  
         IF P1 GR PP3MAX
         THEN BEGIN 
              GROW3;
              GOTO L8;
              END 
         $OBJECT [P1] = P2; 
         END
         XDEF PROC XFORMULA;
         PROC XFORMULA (P1,P2); 
         BEGIN
         ITEM P1, P2; 
         L9:  
         IF P1 GR PP4MAX
         THEN BEGIN 
              GROW4;
              GOTO L9;
              END 
         $FORMULA [P1] = P2;
         $BEGIN 
         IF FORM$STK$TRC THEN 
             BEGIN
             TEMP$ = OCT(P2,10,10); 
             OUTPUT(7,"      FORM","ULA STACK ",DEC(P1),"    IS    ", 
                 TEMP$,"     FL = ",DEC(FL)); 
             END
         $END 
         END
         XDEF PROC XCOMMONSTACK;
         PROC XCOMMONSTACK (P1,P2); 
         BEGIN
         ITEM P1, P2; 
         L10: 
         IF P1 GR PP4MAX
         THEN BEGIN 
              GROW4;
              GOTO L10; 
              END 
         $COMMONSTACK [P1] = P2;
         END
         XDEF PROC XADDRESS;
         PROC XADDRESS (P1,P2); 
         BEGIN
         ITEM P1, P2; 
         L11: 
         IF P1 GR PP5MAX
         THEN BEGIN 
              GROW5;
              GOTO L11; 
              END 
         $ADDRESS [P1] = P2;
         $BEGIN 
         IF PRI$STK$TRC THEN
             BEGIN
             TEMP$ = OCT(P2,13,7);
             OUTPUT(7,"     ADDRE","SS STACK  ",DEC(P1),"    IS    ", 
             TEMP$,"      Z = ",DEC(Z));
             END
         $END 
         END
         XDEF PROC XPRIORITY; 
         PROC XPRIORITY (P1,P2);
         BEGIN
         ITEM P1, P2; 
         L12: 
         IF P1 GR PP5MAX
         THEN BEGIN 
              GROW5;
              GOTO L12; 
              END 
         $PRIORITY [P1] = P2; 
         $BEGIN 
         IF PRI$STK$TRC THEN
             BEGIN
             TEMP$ = OCT(P2,16,4);
             OUTPUT(7,"     PRIOR","ITY STACK ",DEC(P1),"    IS    ", 
                     TEMP$,"      Z = ",DEC(Z));
             END
         $END 
         END
         XDEF PROC XDBUGELEMENT;
         PROC XDBUGELEMENT (P1,P2); 
         BEGIN
         ITEM P1, P2; 
         L13: 
         IF P1 GR PP5MAX
         THEN BEGIN 
              GROW5;
              GOTO L13; 
              END 
         $DBUGELEMENT [P1] = P2;
         $BEGIN 
         IF DBUG$STK$TRC THEN 
             BEGIN
             TEMP$ = OCT(P2,10,10); 
             OUTPUT(5," DEBUGELEM","ENT STACK ",DEC(P1),"    IS    ", 
                     TEMP$);
             END
         $END 
         END
         XDEF PROC PUSH$DSS$PKG;
         PROC PUSH$DSS$PKG; 
           BEGIN
             DSS$STK$PTR = DSS$STK$PTR + 1; 
         L14: 
             IF DSS$STK$PTR GR PP6MAX 
               THEN BEGIN 
                      GROW6;
                      GOTO L14; 
                    END 
             $ENDADDRESS [DSS$STK$PTR] = ENDADDRESS;
             $IMPFLG [DSS$STK$PTR] = IMPFLG;
             $NSFLAG [DSS$STK$PTR] = NSFLAG;
             $NEXT [DSS$STK$PTR] = NEXT$SENTNC; 
             $EXTRA [DSS$STK$PTR] = SAVE$ADDRESS; 
             $VERBLINE [DSS$STK$PTR] = VERB$LINE; 
             $VERBCOL [DSS$STK$PTR] = VERB$COL; 
             RETURN;
           END
         XDEF PROC POP$DSS$PKG; 
         PROC POP$DSS$PKG;
           BEGIN
             IF DSS$STK$PTR LS 0
               THEN BEGIN 
                      ENDADDRESS = 0; 
                      VERB$LINE = 0;
                      VERB$COL = 0; 
                      IMPFLG = 0; 
                      NSFLAG = 0; 
                      NEXT$SENTNC = 0;
                      SAVE$ADDRESS = 0; 
                    END 
             ELSE BEGIN 
                     ENDADDRESS = $ENDADDRESS [DSS$STK$PTR];
                     IMPFLG = $IMPFLG [DSS$STK$PTR];
                     NSFLAG = $NSFLAG [DSS$STK$PTR];
                     NEXT$SENTNC = $NEXT [DSS$STK$PTR]; 
                     SAVE$ADDRESS = $EXTRA [DSS$STK$PTR]; 
                     VERB$LINE = $VERBLINE [DSS$STK$PTR]; 
                     VERB$COL = $VERBCOL [DSS$STK$PTR]; 
                     DSS$STK$PTR = DSS$STK$PTR - 1; 
                   END
             RETURN;
           END
         XDEF PROC PUSH$SRCHALL;
         PROC PUSH$SRCHALL; 
           BEGIN
             SRCH$STK$PTR = SRCH$STK$PTR + 1; 
         L15: 
             IF SRCH$STK$PTR GR PP7MAX
               THEN BEGIN 
                      GROW7;
                      GOTO L15; 
                    END 
             STK$ELEMENT [SRCH$STK$PTR] = TEMP$1; 
             RETURN;
           END
         XDEF PROC POP$SRCHALL; 
         PROC POP$SRCHALL;
           BEGIN
             IF SRCH$STK$PTR GQ 0 
               THEN BEGIN 
                      TEMP$1 = STK$ELEMENT [SRCH$STK$PTR];
                      SRCH$STK$PTR = SRCH$STK$PTR - 1;
                    END 
             RETURN;
           END
         END
TERM
