*DECK CGSETRG 
USETEXT CCTTEXT 
USETEXT DNTEXT
          PROC  CGSETRG;
  
#**       CGSETRG -  SET REG TABLE ENTRIES FROM GTEXT STRING
* 
*         FIXED CELL STRNGPTR INDICATES THE GTEXT ATOM THAT WILL BE 
*           FIRST SET UP. 
*         FIXED CELL BEGINREG INDICATES THE REG TABLE ENTRY THAT
*           WILL DESCRIBE THE FIRST ATOM. 
* 
*         CGSETRG 
* 
* 
*         IF THE REG TABLE ENTRY SPECIFIED BY BEGINREG IS GEND, 
*           THEN NO ACTION IS DONE (EXCEPT FOR POSSIBLE DEBUG PRINTOUT).
* 
*         OTHERWISE, GTEXT ATOMS ARE READ STARTING AT STRNGPTR, 
*           (WITH STRNGPTR INCREMENTED BY 1 EACH TIME)
*           AND SET UP IN THE REG TABLE STARTING AT BEGINREG
*           (BEGINREG IS NOT CHANGED HERE). 
*           SPECIFIC FIELDS IN EACH ENTRY ARE SET ACCORDING TO
*           THE ATOM CODE.
*           THIS PROCESS ALWAYS STOPS IF THE ATOM IS GVERB. 
*           IF THE ATOM IS NOT GVERB, 
*           THIS PROCESS CONTINUES UNTIL REG7 HAS BEEN SET UP.
* 
*           AFTER THIS PROCESS HAS STOPPED, REGGATOM1[REG7] 
*           IS ENSURED TO CONTAIN THE ATOM OF THE NEXT VERB:  
*             IF A VERB HAS ALREADY BEEN READ,
*             THE ATOM IS PUT IN REGGATOM1[REG7]. 
*             OTHERWISE THE GTEXT IS READ (WITHOUT ADVANCING STRNGPTR)
*             UNTIL A VERB IS FOUND,
*             AND FIXED CELL BEGINREG IS SET TO REG2. 
*           ALSO, FIXED CELL CURGTEXT CONTAINS THE INDEX TO THE 
*             REG TABLE ENTRY OF THE NEXT VERB. 
* 
*         FINALLY, DEBUG INFORMATION MAY BE PRINTED.
# 
  
          BEGIN 
  
          XREF
              BEGIN 
              PROC  BUG202REGTDP;      # DUMP REGTABL                  #
              PROC  CBLIST;            # PROCESS COBOL LIST FILE       #
              PROC  SCANLIT;           # SCAN NUMERIC LITERAL          #
              FUNC  DEC          C(10);# DECIMAL DISPLAY VALUE         #
              PROC  GETPLST;           # GET PLT STRING ENTRY          #
              FUNC  GTEXTATOM    I;    # SPECIFIED GTEXT ATOM          #
              PROC  SPECSUB;           # FIND SPECIAL CASE SUBSCRIPTS  #
              FUNC  VIRTUAL      I;    # INDEX TO A MANAGED TABLE      #
              END 
  
          XDEF PROC POOLQLT;
  
  
  
*CALL M$
  
          $BEGIN
*CALL BUG202C 
          $END
  
  
*CALL DNATVALS
  
*CALL FIXCOM
  
*CALL FIXED 
  
*CALL GTEXT 
  
*CALL LAT1
  
*CALL LISTCTL 
  
*CALL PLT1
  
*CALL PLTVALS 
  
*CALL PNAT1 
  
*CALL RALINE
  
*CALL REGTABL 
  
*CALL SUBTYPE 
  
*CALL SUBINFO 
  
*CALL TABLETYP
  
  
          ITEM  DX           I;        # ABSOLUTE INDEX TO DNAT        #
          ITEM  GSCODE       I;        # TO HOLD REGGSCODE[REGINDEX]   #
          ITEM  I            I;        # SCRATCH                       #
          ITEM  J            I;        # SCRATCH                       #
          ITEM  MORETODO     B;        # TRUE IFF MORE ATOMS TO SET UP #
          ITEM  NUMERICLIT   C(240);   # CURRENT NUMERIC LITERAL       #
          ITEM NUMLITCONT C(15);       # THIS MUST FOLLOW NUMERICLIT.  #
                                       # SINCE SYMPL ONLY ALLOWS 240   #
                                       # CHAR ITEMS AND COBOL ALLOWS   #
                                       # 255 CHAR LITS                 #
          ITEM  PX           I;        # ABSOLUTE INDEX TO PNAT        #
          ITEM  REGINDEX     I;        # INDEX TO REG TABLE            #
           ITEM  SUBSCRIPT; 
          ITEM  T            I;        # SCRATCH                       #
          ITEM  TEMP         I;        # SCRATCH                       #
          ITEM  VDX          I;        # VIRTUAL INDEX TO DNAT         #
          ITEM  VLX          I;        # VIRTUAL INDEX TO LAT          #
          ITEM  VPX          I;        # VIRTUAL INDEX TO PLT          #
  
          DEF  GTEXTPTR      #FIXEDCELL[FIXED"STRNGPTR"]#;
  
 #     ADVANCE DEBUG PRINT ARRAY                                       #
  
          $BEGIN
          ARRAY [0] S(7); 
          BEGIN 
            ITEM ADVLINE     C(0,0,67); 
            ITEM ADVLINE1    C(0,0,10) = ["ADVANCE TO"];
            ITEM ADVLINE2    C(1,0,10) = [" NEXT VERB"];
            ITEM ADVLINE21   C(2,0,10) = ["          "];
            ITEM ADVLINE3    C(3,0,1) = [" "];
            ITEM ADVNEW      C(3,6,5) = ["     "];
            ITEM ADVLINE4    C(3,36,7) = ["LINE = "]; 
            ITEM ADVLINENO   C(4,18,7) = ["       "]; 
            ITEM ADVLINE5    C(5,0,10) = [" COLUMN = "];
            ITEM ADVCOLUMNNO C(6,0,7)  = ["       "]; 
          END 
          $END
  
  
          SWITCH  GCODESW 
               ,  DATAREF    #1#
               ,  FILEREF    #2#
               ,  LABLREF    #3#
               ,  LITREF     #4#
               ,  PROCREF    #5#
               ,  SUBATOM    #6#
               ,  SUBVERB    #7#
               ,  SYSREF     #8#
               ,  VERB       #9#
               ,  TEMPREF    #10# 
               ;
  
#  IF ANY OF THE BELOW TESTS GET AN ERROR,  CHANGE:                    #
#      SWITCH GCODESW ABOVE.                                           #
#      SWITCH FWA$OFL IN DECK VALFUNC                                  #
          CONTROL IFNQ GDATAREF,1; ERROR; CONTROL ENDIF;
          CONTROL IFNQ GFILEREF,2; ERROR; CONTROL ENDIF;
          CONTROL IFNQ GLABLREF,3; ERROR; CONTROL ENDIF;
          CONTROL IFNQ GLITREF,4;  ERROR; CONTROL ENDIF;
          CONTROL IFNQ GPROCREF,5; ERROR; CONTROL ENDIF;
          CONTROL IFNQ GSUBATOM,6; ERROR; CONTROL ENDIF;
          CONTROL IFNQ GSUBVERB,7; ERROR; CONTROL ENDIF;
          CONTROL IFNQ GSYSREF,8;  ERROR; CONTROL ENDIF;
          CONTROL IFNQ GVERB,9;    ERROR; CONTROL ENDIF;
          CONTROL IFNQ GTEMPREF,10;ERROR; CONTROL ENDIF;
          CONTROL  EJECT; 
          PROC   POOLQLT; 
 #     POOL A QUOTED LITERAL USED AS SOURCE IN MOVE TO NUMERIC ITEM.   #
 #     INPUT -                                                         #
 #            REGT - DNAT POINTER                                      #
 #            P1 - REQUIRED INTEGER LENGTH                             #
          ITEM  PLTINDEX; 
          ITEM  STRING C(240);
          ITEM  NSTRING  C(20); 
          XREF  PROC  GETPLST;
          XREF  PROC  LITPOOL;
          ITEM  POOLLEN;
          BEGIN 
          GETPLST(REGLITPLT[FIXEDCELL[ FIXED"REGT"]],LOC(STRING));
          PLTINDEX = VIRTUAL(TABLETYPE"PLT$",REGLITPLT[FIXEDCELL[ 
                             FIXED"REGT"]]);
          IF  PL$FIGCON[PLTINDEX] NQ 0
          THEN
              BEGIN 
              POOLLEN = FIXEDCELL[FIXED"P1"]; 
              IF  PL$FIGQUOTE[PLTINDEX] EQ 1
              THEN  FOR I = 0 STEP 1 UNTIL POOLLEN - 1
                  DO  C<I,1>NSTRING = C<0,1>STRING; 
              IF  PL$FIGLOWV[PLTINDEX] EQ 1 
              THEN  FOR I = 0 STEP 1 UNTIL POOLLEN - 1
                  DO  C<I,1>NSTRING = C<0,1>CCTLOVALUE; 
              IF  PL$FIGHIGHV[PLTINDEX] EQ 1
              THEN  FOR I = 0 STEP 1 UNTIL POOLLEN  - 1 
                  DO  C<I,1>NSTRING = C<0,1>CCTHIVALUE; 
              END 
          ELSE
          BEGIN 
          IF  PL$LENGTH[PLTINDEX] LQ FIXEDCELL[FIXED"P1"] 
          THEN
              BEGIN 
              POOLLEN = PL$LENGTH[PLTINDEX];
              C<0,POOLLEN>NSTRING = C<0,POOLLEN>STRING; 
              END 
          ELSE
              BEGIN 
              POOLLEN = FIXEDCELL[FIXED"P1"]; 
              C<0,POOLLEN>NSTRING = C<PL$LENGTH[PLTINDEX]-POOLLEN,
                                      POOLLEN>STRING; 
              END 
          END 
          FIXEDCELL[FIXED"P2"] = LOC(NSTRING);
          DN$ITMLEN[VIRTUAL(TABLETYPE"DNAT$",REGDNATADDR[FIXEDCELL[ 
                      FIXED"REGT"]])] = POOLLEN;
          FIXEDCELL[FIXED"P1"] = 1; 
          LITPOOL;
          REGCHARPOS[FIXEDCELL[FIXED"REGT"]] =0;
          REGITMLEN[FIXEDCELL[FIXED"REGT"]] = POOLLEN;
          RETURN; 
          END 
CONTROL EJECT;
  
#      DECIDE WHETHER TO READ ATOMS                                    #
  
          REGINDEX = FIXEDCELL[FIXED"BEGINREG"];
  
          IF REGGCODE[REGINDEX] NQ GEND  THEN 
              MORETODO = TRUE;
          ELSE
              BEGIN 
              MORETODO = FALSE; 
              REGINDEX = REGINDEX + 1;           # FOR TEST AFTER LOOP #
              END 
  
          GTEXTPTR = GTEXTPTR - 1;
  
  
#      PROCESS GTEXT ATOMS INTO REG TABLE ENTRIES                      #
  
          FOR REGINDEX = REGINDEX STEP 1 WHILE MORETODO  DO 
              BEGIN 
  
#          CLEAR THIS REG TABLE ENTRY                                  #
  
              REGWORD0[REGINDEX] = 0;            # WORD 0              #
              REGDNATADDR[REGINDEX] = 0;         # WORD 1              #
              REGWORD2[REGINDEX] = 0;            # WORD 2              #
          REGWORD3[REGINDEX] = 0; 
              REGWORD4[REGINDEX] = 0; 
  
#          GET THE NEXT GTEXT ATOM                                     #
  
              GTEXTPTR = GTEXTPTR + 1;
              REGGATOM1[REGINDEX] = GTEXTATOM(GTEXTPTR);
  
#          IF THIS ENTRY IS NORMALLY THE LAST ONE,  INDICATE SO        #
  
              IF REGINDEX EQ FIXED"REG7"  THEN
#MORETODO#        MORETODO = FALSE; 
  
#          SET SPECIFIC REG TABLE ENTRIES ACCORDING TO CODE OF ATOM    #
  
              GOTO GCODESW[REGGCODE[REGINDEX]]; 
  
  
 DATAREF: 
              DX = REGGPTR[REGINDEX]; 
              VDX = VIRTUAL(TABLETYPE"DNAT$", DX);
              REGLEVEL[REGINDEX] = DN$LEVEL[VDX]; 
              REGCHARPOS[REGINDEX] = DN$CHARPOS[VDX]; 
          REGSIGNBIT[REGINDEX] = DN$SIGNBIT[VDX]; 
          REGNUMLEN[REGINDEX] = DN$NUMLEN[VDX]; 
          REGPOINT[REGINDEX] = DN$POINT[VDX]; 
          REGTYPE[REGINDEX] = DN$TYPE[VDX]; 
          REGITMLEN[REGINDEX] = DN$ITMLEN[VDX]; 
          REGTREG[REGINDEX] = DN$TREG[VDX]; 
              REGJUST[REGINDEX] = DN$JUST[VDX]; 
              REGSYNC[REGINDEX] = DN$SYNC[VDX]; 
              GSCODE = REGGSCODE[REGINDEX]; 
              REGDNATADDR[REGINDEX] = DX; 
              IF  GSCODE NQ 0 
              THEN
                  BEGIN      #MODIFIED DNAT # 
                  T = REGCHARPOS[REGINDEX]; 
                  SUBSCRIPT = SUBNUMBER[GSCODE];
                  IF  SUBSCRIPT NQ 0
                  THEN
                      BEGIN  #SUBSCRIPTED DNAT #
                      IF  SUBTYP[SUBSCRIPT] EQ S"SCON"
                          AND (RFLCPTYPE[GSCODE] EQ 0 OR
                              (RFLCPTYPE[GSCODE] EQ S"SCON" AND 
                              RFLENTYPE[GSCODE] NQ S"SCALCR"))
                      THEN
                          BEGIN 
                          T = T + SUBOFFS[SUBSCRIPT]; 
                          REGGSCODE[REGINDEX] = 0;
                          END 
                      IF  SUBTYP[SUBSCRIPT] NQ S"SCON"
                          AND RFLCPTYPE[GSCODE] EQ 0
                      THEN  SPECSUB(REGINDEX);   #CHECK SPECIAL CASES # 
                      END 
                  IF  RFLCPTYPE[GSCODE] NQ 0
                  THEN
                    BEGIN  #REFERENCE MODIFIED DNAT                    #
                      IF  REGTYPE[REGINDEX] NQ ALPHNUM
                          AND REGTYPE[REGINDEX] NQ BOOLDSP
                      THEN
                          REGTYPE[REGINDEX] = ALPHNUM;
              REGJUST[REGINDEX] = 0;
                      IF  RFLCPTYPE[GSCODE] EQ S"SCON"
                          AND RFLENTYPE[GSCODE] NQ S"SCALCR"
                          AND (SUBSCRIPT EQ 0 
                               OR  SUBTYP[SUBSCRIPT] EQ S"SCON")
                       THEN 
                          BEGIN 
                          T = T + RFLCPVALUE[GSCODE] - 1; 
                          IF  RFLENTYPE[GSCODE] EQ S"SCON"
                          THEN
                              REGITMLEN[REGINDEX] = RFLENVALUE[GSCODE]; 
                          ELSE     #END#
                              REGITMLEN[REGINDEX] = REGITMLEN[REGINDEX] 
                                             - RFLCPVALUE[GSCODE] + 1;
                          REGGSCODE[REGINDEX] = 0;
                          REGSYNC[REGINDEX] = 0;
                          END 
                      END 
                  REGCHARPOS[REGINDEX] = T - T/10*10; 
                  REGWORDINDX[REGINDEX] = T/10; 
                  END 
              TEST REGINDEX;
  
  
 FILEREF: 
              REGDNATADDR[REGINDEX] = REGGPTR[REGINDEX];
              TEST REGINDEX;
  
  
 LABLREF: 
#***GOTO#     GOTO PROCREF;                      # SAME AS *PROCREF*   #
  
  
 LITREF:  
              REGLITFLAG[REGINDEX] = 1; 
              VLX = VIRTUAL(TABLETYPE"LAT$", REGLATADDR[REGINDEX]); 
              DX = L$DNAT[VLX]; 
          REGDNATADDR[REGINDEX] = DX; 
              VDX = VIRTUAL(TABLETYPE"DNAT$", DX);
              REGCHARPOS[REGINDEX] = DN$CHARPOS[VDX]; 
  
#              SET UP REFERENCES TO NUMERIC OR IMMEDIATE LITERAL       #
  
                  IF L$IMMEDIATE[VLX] EQ 0  THEN
                      BEGIN                      # NORMAL LITERAL      #
                      VPX = VIRTUAL(TABLETYPE"PLT$", L$PLT[VLX]); 
                      IF  DN$MAJMSEC[VDX] NQ LITMSEC AND   #NOT POOLED# 
                          (PL$CODE[VPX] EQ PLTINTLIT OR 
                           PL$CODE[VPX] EQ PLTFLTLIT OR 
                           PL$CODE[VPX] EQ PLTQUOTEDLIT OR
                           PL$CODE[VPX] EQ PLTNUMLIT) 
                  THEN
                          BEGIN                  # NORMAL NUMERIC LIT. #
                  REGLITIMM[REGINDEX] = 0;
                  REGLITLEN[REGINDEX] = PL$LENGTH[VPX]; 
                  REGLITPLT[REGINDEX] = L$PLT[VLX]; 
                          IF PL$SIGNEDFLG[VPX] EQ 1 # IF HAD SIGN CHAR# 
                           AND PL$SIGNFLAG[VPX] EQ 0 #AND IT WAS -   #
                           THEN 
                              BEGIN 
                     REGLITSGN[REGINDEX] = 1; 
                              DN$SIGNBIT[VDX] = 1;
                              END 
                          ELSE
                              BEGIN 
                     REGLITSGN[REGINDEX] = 0; 
                              DN$SIGNBIT[VDX] = 0;
                              END 
                  GETPLST(REGLITPLT[REGINDEX],LOC(NUMERICLIT)); 
                          TEMP = LOC(NUMERICLIT); 
                  B<2,10>TEMP = REGLITLEN[REGINDEX];
                          B<0,2>TEMP = 1;        # TEMP NOW = LITREFOF #
                          SCANLIT(TEMP, I, J);   # SET NUMLEN, POINT   #
                          IF I LS 0  THEN 
                              BEGIN 
                              I = 0;
                              J = 0;
                              DN$TYPE[VDX] = COMP2; 
                              END 
                          ELSE DN$TYPE[VDX] = COMP; 
                          DN$NUMLEN[VDX] = I; 
                          DN$POINT[VDX] = J;
                          END 
                      END 
                  ELSE
                      BEGIN                      # IMMEDIATE LITERAL   #
                  REGLITIMM[REGINDEX] = 1;
                      TEMP = L$PLT[VLX];        # BINARY NUMERIC VALUE# 
                      I = 1;                     # TENTATIVE NUMLEN    #
                      IF TEMP GQ 10  THEN 
                          I = 2;
                      IF TEMP GQ 100  THEN
                          I = 3;
                      IF TEMP GQ 1000  THEN 
                          I = 4;
                      IF TEMP GQ 10000  THEN
                          I = 5;
                      IF L$SPACES[VLX] EQ 0 THEN DN$TYPE[VDX] = COMP; 
                      DN$NUMLEN[VDX] = I; 
                      DN$POINT[VDX] = 0;
                  REGLITLEN[REGINDEX] = I;
                  REGLITPLT[REGINDEX] = TEMP; 
                      END 
          REGSIGNBIT[REGINDEX] = DN$SIGNBIT[VDX]; 
          REGNUMLEN[REGINDEX] = DN$NUMLEN[VDX]; 
          REGPOINT[REGINDEX] = DN$POINT[VDX]; 
          REGTYPE[REGINDEX] = DN$TYPE[VDX]; 
          REGITMLEN[REGINDEX] = DN$ITMLEN[VDX]; 
          REGTREG[REGINDEX] = DN$TREG[VDX]; 
              REGSYNC[REGINDEX] = DN$SYNC[VDX]; 
              REGJUST[REGINDEX] = DN$JUST[VDX]; 
              REGLEVEL[REGINDEX] = DN$LEVEL[VDX]; 
              TEST REGINDEX;
  
  
 PROCREF: 
              PX = REGGPTR[REGINDEX]; 
              VPX = VIRTUAL(TABLETYPE"PNAT$", PX);
              FOR T = T WHILE PN$EQUATE[VPX] NQ 0 DO
                  BEGIN 
                  PX = PN$EQUATE[VPX];
                  VPX = VIRTUAL(TABLETYPE"PNAT$", PX);
                  END 
              REGPNATADDR[REGINDEX] = PX; 
              REGGPTR[REGINDEX] = PX; 
              TEST REGINDEX;
  
  
 SUBATOM: 
              REGGATOM2[REGINDEX-1] = REGGATOM1[REGINDEX];
              TEST REGINDEX;
  
  
 SUBVERB:   
              TEST REGINDEX;
  
  
 SYSREF:  
              REGDNATADDR[REGINDEX] = REGGPTR[REGINDEX];
              TEST REGINDEX;
 TEMPREF: 
              REGDNATADDR[REGINDEX] = REGGPTR[REGINDEX];
              TEST REGINDEX;
  
  
 VERB:  
              IF REGINDEX LQ FIXED"REG7"  THEN
                  BEGIN 
              REGWORD0[FIXED"REG7"] = REGWORD0[REGINDEX]; 
                  FIXEDCELL[FIXED"CURGTEXT"] = REGINDEX;
                  END 
              ELSE
              BEGIN 
              FIXEDCELL[FIXED"CURGTEXT"] = FIXED"REG7" - 1; 
                  END 
#***TERM#     MORETODO = FALSE; 
              TEST REGINDEX;
  
              END  #REGINDEX# 
#             AT THIS POINT,  REGINDEX IS 1 BEYOND LAST ENTRY          #
  
  
#      ENSURE THAT REG7 IS THE NEXT VERB                               #
  
          IF REGGCODE[REGINDEX-1] NQ GVERB  AND 
             REGGCODE[REGINDEX-1] NQ GEND   THEN
              BEGIN 
              FIXEDCELL[FIXED"CURGTEXT"] = FIXED"REG7"; 
              REGGCODE[FIXED"REG7"] = 0;         # SET CODE NQ GVERB   #
              FOR T = GTEXTPTR+1 STEP 1 
               WHILE REGGCODE[FIXED"REG7"] NQ GVERB  DO 
                  REGGATOM1[FIXED"REG7"] = GTEXTATOM(T);
          FIXEDCELL[FIXED"BEGINREG"] = FIXED"REG2"; 
              END 
  
#      PUT LINE NUMBER IN RA+3                                         #
  
          IF REGGSCODE [FIXED"REG1"] EQ GVERBDES  THEN
              RA$LINE = REGGPTR[FIXED"REG2"]; 
  
  
#      HANDLE DEBUG PRINTOUT                                           #
  
          $BEGIN
  
          IF REGGSCODE[FIXED"REG1"] EQ GVERBDES  THEN 
              BEGIN 
              BUG202C$WORD[0] = 0;               # CLEAR LOCAL FLAGS   #
              TEMP = REGGPTR[FIXED"REG2"];       # LINE NUMBER         #
              BUG202C$LINE = TEMP;
  
              BUG202C$ANYF[0] = FALSE;           # NO FLAGS SET YET    #
              FOR I = 1 STEP 1 UNTIL BUG202C$NFLG  DO 
                  BEGIN 
                  IF B<I,1>BUG202C$WORD[1] NQ 0  THEN 
                      BEGIN 
                      IF TEMP GQ BUG202C$BEGL[I]
                       AND TEMP LQ BUG202C$ENDL[I]  THEN
                          BEGIN 
                          B<I,1>BUG202C$WORD[0] = 1;
                          BUG202C$ANYF[0] = TRUE; 
                          END 
                      END 
                  END 
              END 
  
#      PERHAPS GIVE AN *ADVANCE-VERB* DUMP                             #
  
          IF BUG202C$DMPA[0]  THEN               # IF DUMP ADVANCE-VERB#
              BEGIN 
              IF REGGSCODE[FIXED"REG1"] EQ GVERBDES  THEN 
                  BEGIN 
                  ADVLINENO[0] = DEC(REGGPTR[FIXED"REG2"]); 
                  ADVCOLUMNNO[0] = DEC(REGGSCODE[FIXED"REG2"]); 
                  ADVNEW[0] = "NEWW"; 
                  END 
              ELSE
                  BEGIN 
                  ADVNEW[0] = "THIS"; 
                  END 
              CBLIST(LISTCTL"LINE", ADVLINE[0], 67);
              END 
  
#      PERHAPS DUMP THE REGTABL                                        #
  
          IF BUG202C$DMPR[0]  THEN
              BUG202REGTDP(FIXED"REG1", FIXED"REG7", 1);
          $END
  
          END 
          TERM
