*DECK PQ2 
USETEXT PPTEXT
PROC PQ2 (P1,P2,P3,P4); 
         BEGIN
         XREF FUNC STACK; 
         XREF FUNC LINE;
         XREF FUNC COLUMN;
         XREF FUNC TPOINTER;
         XREF FUNC TCODE; 
         XREF FUNC TSUBCODE;
         XREF FUNC PRIORITY;
         XREF FUNC ADDRESS; 
         XREF FUNC FORMULA; 
         XREF FUNC SUBJECT; 
         XREF FUNC OBJECT;
         XREF FUNC DEBUGELEMENT;
         XREF FUNC RFFLAG;
         XREF FUNC COMMONSTACK; 
         XREF PROC XRFFLAG; 
         XREF FUNC GTX; 
         ITEM P1,P2,P3,P4;
         ITEM R1, R2, R3, R4, R5, R6, R7, R8, R9, R10, R11; 
*CALL DPPPDDATA 
*CALL PPCOMMON2 
*CALL DNATVALS
          $BEGIN
          XREF ITEM GTEXT$TRACE   B;   # GTEXT TRACE FLAG              #
          XREF PROC OUTPUT;            # PRINT ON LISTING FILE         #
          XREF PROC GTXTDMP;           # GTEXT DUMP ROUTINE            #
          $END
         CONTROL EJECT; 
         #-----INTERNAL PROCEDURES-----#
FUNC INTERNALGTX (P1,P2,P3);
         BEGIN
         ITEM P1, P2, P3, P4; 
         ARRAY [0] S(1);
         BEGIN
         ITEM G0 U(0,0,60); 
         ITEM G1 U(0,30,6); 
         ITEM G2 U(0,36,15);
         ITEM G3 U(0,51,9); 
         END
         G1[0] = P1;
         G2[0] = P2;
         G3[0] = P3;
         INTERNALGTX = G0[0]; 
         RETURN;
         END #INTERNALGTX#
         CONTROL EJECT; 
         #-----MAIN LINE-----#
ENTRY PROC XPP1 (P1,P2,P3,P4);
         #ERROR#
         #P1 - SEVERITY#
         #P2 - ERROR NUMBER#
         #P3 - LINE NUMBER# 
         #P4 - COLUMN NUMBER# 
         BEGIN
         IF P1 EQ 2 OR P1 EQ 3
         THEN FREEZEFLAG = 0; 
         INTERCEPTOR(P4,P3,P2,P1);
         RETURN;
         END #XPP1# 
ENTRY FUNC XPP8 (P1, P2); 
         #CREATE LITERAL-ATOM, DNAT, LAT# 
         #P1 - DNAT FROM WHICH TO COPY ATTRIBUTES#
         #P2 - DESIRED VALUE FOR LAT IMMEDIATE FIELD# 
         BEGIN
         R1 = INTERNALGTX(GLITREF,(NEXTLAT),0); 
         LITERALDNAT(P1,DNATLENGTH);
         SET(L$IMMEDIATE,LAT$,LATLENGTH,P2);
         XPP8 = R1; 
         RETURN;
         END #XPP8# 
ENTRY PROC XPP30 (P1);
         #TEMPSPACE#
         #P1 - DNAT POINTER#
         BEGIN
         IF TSCOPEFLAG EQ 0 
         THEN  LOCALTEMP(P1); 
         ELSE  GLOBALTEMP(P1);
         RETURN;
         END #XPP30#
ENTRY FUNC PLTCHARACTER (P1,P2) C(1); 
         #YOU TELL US THE PLT ENTRY NUMBER AND THE CHARACTER# 
         #NUMBER - .. WE RETURN THE CHARACTER#
         #P1 - PLT ENTRY NUMBER#
         #P2 - CHARACTER NUMBER (1,2,...,PL$LENGTH)#
         BEGIN
         R1 = GET(PL$STRINGPTR,PLT$,P1);
         R2 = GET(PL$LENGTH,PLT$,P1); 
         IF P2 LS 1 OR P2 GR R2 
         THEN INTERCEPTOR (COLUMN$,LINE$,94,2); 
         #CALCULATE WORD NUMBER RELATIVE TO START OF LITERAL# 
         R3 = (P2 - 1) / 10;
         #CALCULATE WORD NUMBER RELATIVE TO START OF TABLE# 
         R4 = R1 + R3;
         #CALCULATE CHARACTER POSITION WITHIN THE WORD# 
         R5 = P2 - 10 * R3 - 1; 
         #GET THE WORD AND CHARACTER# 
         R6 = GET(PLT$CHAR,PLTSTR$,R4); 
         PLTCHARACTER = C<R5,1> R6; 
         RETURN;
         END #PLTCHARACTER# 
ENTRY PROC NG (P1); 
         BEGIN
         G = G + 1; 
         IF B<59,1> G EQ 0
         THEN SET(GTEXTATOM1,GTEXT$,G/2,P1);
         ELSE SET(GTEXTATOM2,GTEXT$,G/2,P1);
         $BEGIN IF GTEXT$TRACE THEN GTXTDMP(G,G,0,0,0); $END
         RETURN;
         END #NG# 
ENTRY FUNC GTX (P1,P2,P3);
         BEGIN
         ARRAY [0] S(1);
         BEGIN
         ITEM G0 U(0,0,60); 
         ITEM G1 U(0,30,6); 
         ITEM G2 U(0,36,15);
         ITEM G3 U(0,51,9); 
         END
         G1[0] = P1;
         G2[0] = P2;
         G3[0] = P3;
         GTX = G0[0]; 
         RETURN;
         END #GTX#
ENTRY FUNC GETGT (P1);
         BEGIN
         IF B<59,1> P1 EQ 0 
         THEN GETGT = GET(GTEXTATOM1,GTEXT$,P1/2);
         ELSE GETGT = GET(GTEXTATOM2,GTEXT$,P1/2);
         $BEGIN 
         IF GTEXT$TRACE THEN
             BEGIN
             OUTPUT(1," GETGTEXT ");
             GTXTDMP(P1,P1,0,0,0);
             END
         $END 
         RETURN;
         END #GETGT#
ENTRY PROC SETGT (P1,P2); 
         BEGIN
         IF B<59,1> P1 EQ 0 
         THEN SET(GTEXTATOM1,GTEXT$,P1/2,P2); 
         ELSE SET(GTEXTATOM2,GTEXT$,P1/2,P2); 
         $BEGIN 
         IF GTEXT$TRACE THEN
             BEGIN
             OUTPUT(1," SETGTEXT ");
             GTXTDMP(P1,G,0,0,0); 
             OUTPUT(1," *********");
             END
         $END 
         RETURN;
         END #SETGT#
    ENTRY FUNC BYTE(BITSTR,INDEX)    I; 
          BEGIN 
         ITEM INDEX  I; 
         ITEM MOD    I; 
         ITEM REM    I; 
         ARRAY BITSTR [0:17]; 
               ITEM BITSTRI  U; 
         MOD = INDEX/7; 
         REM = INDEX - INDEX/7 * 7; 
         BYTE = B<REM*8,8> BITSTRI[MOD];
         RETURN;
         END  #FUNC BYTE# 
         END #PQ2#
         TERM 
