*DECK SPECSUB 
USETEXT DNTEXT
          PROC  SPECSUB(REGINDEX);
  
#**       SPECSUB -  CHECK FOR SPECIAL CASE SUBSCRIPTS
* 
*         REGINDEX = REGTABLE INDEX OF DNAT ITEM
* 
*         EXECUTE SPECSUB(REGINDEX) 
* 
* 
*         IF SPECIAL CASE IN-LINE CODE CAN BE GENERATED FOR SUBSCRIPTED 
*           LOADS AND STORES OF THE SPECIFIED ITEM, 
*           SETS REGSUBSC TO THE TYPE OF SPECIAL CASE.
# 
  
  
*CALL M$
  
*CALL AUXT1 
  
*CALL AUXTVALS
  
  
*CALL REGTABL 
*CALL TABLETYP
          CONTROL  EJECT; 
          ITEM  AUXTINDX; 
          ITEM  BCP;
          ITEM  DNATADDR; 
          ITEM  I;
          ITEM  J;
          ITEM  NSUBS;
          ITEM  REGINDEX; 
          ITEM  SIZE; 
          ARRAY  [1:3]; 
              ITEM  OCCLEN; 
          XREF  FUNC  VIRTUAL;
          CONTROL  EJECT; 
          FUNC  MOD(I,J); 
          ITEM  I;
          ITEM  J;
          BEGIN 
          MOD = I - (I/J) * J;
          RETURN; 
          END 
          CONTROL  EJECT; 
          BEGIN 
          REGSUBSC[REGINDEX] = 0; 
          DNATADDR = VIRTUAL(TABLETYPE"DNAT$",REGDNATADDR[REGINDEX]); 
          NSUBS = DN$SDEPTH[DNATADDR];
          IF NSUBS EQ 0 OR NSUBS GR 3 THEN RETURN;
          SIZE = DN$ITMLEN[DNATADDR]; 
          BCP = DN$CHARPOS[DNATADDR]; 
          AUXTINDX = DN$AUXREF[DNATADDR]; 
          FOR I = 1 STEP 1 UNTIL 3 DO OCCLEN[I] = 0;
          FOR  I = 1 STEP 1 UNTIL NSUBS DO
              BEGIN 
              FOR  J = J
                  WHILE AX$TTYPE[VIRTUAL(TABLETYPE"AUX$",AUXTINDX)] 
                     NQ MAXOCCUR
                     OR AX$SUBSLVL[VIRTUAL(TABLETYPE"AUX$",AUXTINDX)] 
                     NQ I  DO 
                  AUXTINDX = AX$TNEXTPTR[VIRTUAL(TABLETYPE"AUX$", 
                                                 AUXTINDX)];
              OCCLEN[I] = AX$OCCLEN[VIRTUAL(TABLETYPE"AUX$",AUXTINDX)]; 
              END 
          IF  NSUBS  EQ 1 
          THEN
              BEGIN 
              IF SIZE EQ 1 AND OCCLEN[1] EQ 1 AND BCP EQ 0
              THEN
                  BEGIN 
                  REGSUBSC[REGINDEX] = 5; 
                  RETURN; 
                  END 
              IF  SIZE EQ 5 AND MOD(OCCLEN[1],5) EQ 0  AND
                  MOD(OCCLEN[1],10) NQ 0 AND (BCP EQ 0 OR BCP EQ 5) 
              THEN
                  BEGIN 
                  REGSUBSC[REGINDEX] = 4; 
                  RETURN; 
                  END 
              IF SIZE EQ 2 AND OCCLEN[1] EQ 2 AND BCP EQ 0
              THEN
                  BEGIN 
                  REGSUBSC[REGINDEX] = 3; 
                  RETURN; 
                  END 
              END 
          IF  (NSUBS EQ 1 AND MOD(OCCLEN[1],10) EQ 0) 
              OR  (NSUBS EQ 2 AND MOD(OCCLEN[2],10) EQ 0
                  AND MOD(OCCLEN[1],OCCLEN[2]) EQ 0)
              OR  (NSUBS EQ 3 AND MOD(OCCLEN[3],10) EQ 0
                  AND MOD(OCCLEN[2],OCCLEN[3]) EQ 0 
                  AND MOD(OCCLEN[1],OCCLEN[2]) EQ 0)
          THEN
              BEGIN 
              IF  SIZE EQ 10
              THEN
                  BEGIN 
                  REGSUBSC[REGINDEX] = 1; 
                  RETURN; 
                  END 
              IF  SIZE + BCP LQ 10
              THEN
                  BEGIN 
                  REGSUBSC[REGINDEX] = 2; 
                  RETURN; 
                  END 
              END 
          RETURN; 
          END 
          TERM
