*DECK CNTRLCL 
USETEXT DNTEXT
USETEXT RPTEXT
PROC CNTRLCL; 
          BEGIN 
  
          #DECLARATIONS FOR CNTRLCL#
  
          ITEM   F1CNTRLAUXIN,
                 LCNTRLAUXIND,
                 AUXINDEX    ,
                 CIDNATPTR   ,
                 CURRCILINENO,
                 CURRCICOLNO ,
                 NEXTCILINENO,
                 NEXTCICOLNO ;
  
          XREF   PROC         CTBUILD;
  
  
          ITEM   $TEMP$,
                $DUMMY$;
  
          XREF   FUNC         OVERLAP;
          XREF   PROC         INTERCEPT;
          XREF   FUNC         PLTCNVRT I; 
          XREF   PROC         RWSET    ;
          XREF   PROC         RWSET1   ;
          XREF   PROC         GETNEXT  ;
          XREF   FUNC         RP$AUXPTR;
          XREF   FUNC         RWGET    ;
          XREF   FUNC         RWGET1   ;
  
          DEF    GET          #GETFIELD#; 
          DEF    SET          #SETFIELD#; 
          DEF    GETQ         #GETQUICK#; 
  
          DEF    CALLCDIAG(P1,P2,P3) #INTERCEPT(P3,P1,P2,ADVISORY)#;
  
*CALL RPCOMM
*CALL DNATVALS
*CALL GETSET
*CALL TABLNAMES 
  
  
  
          CONTROL EJECT;
  
  
  
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  # * #   EPTRACE("CNTRLCL")                                       # * #
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
          #INITIALIZE FOLLOWING 2 POINTERS TO MAKE THEM#
          #VALID FOR CDILINK TABLE USE# 
          CIDTPTRCURRD = 0; 
          ENDCIDTCURRD = 0; 
          F1CNTRLAUXIN = 2 + RP$AUXPTR(DNATPOINTER);
          IF  RWGET(NUMCONTRLIDS,F1CNTRLAUXIN) EQ 0 OR
              RWGET(NUMCONTRLIDS,F1CNTRLAUXIN) EQ 1 AND 
              RWGET(CONTIDNATPTR,F1CNTRLAUXIN) EQ 0 
          THEN
              GOTO CALCONTROLST;
          #BUILD ADDITIONAL ENTRIES ONTO CONTROL-IDENTIFIER-TABLE CIDT# 
          #USING CONTROL-TYPE AUX ENTRIES ASSOCIATED WITH CURRENT RD# 
          #AS THE BASIC SOURCE OF INFORMATION.  RPARSER AND PPARSER#
          #WILL USE THIS TO CHECK RULE  # 
          #6.41.3.5 UNDER THE TYPE CLAUSE.(P-PARSER WILL USE IT ALSO# 
          #TO CHECK SEVERAL OTHER RULES. -EG. TYPE CLAUSE 6.41.4.13)# 
          #X# 
  
          CIDTPTRCURRD = NEXTCIDTPTR; 
          LCNTRLAUXIND = RWGET(NUMCONTRLIDS,F1CNTRLAUXIN) -1  + 
                               F1CNTRLAUXIN;
          FOR AUXINDEX = F1CNTRLAUXIN     STEP 1 UNTIL
              LCNTRLAUXIND DO 
              BEGIN 
              CIDNATPTR = RWGET(CONTIDNATPTR,AUXINDEX); 
              IF CIDNATPTR EQ 0 
                  #INDICATING C.I. = FINAL# 
              THEN
                  GOTO CIDOEND; 
              GETNEXT(CIDTLINK);
              NUMCIDTNTRYS = 1 + NUMCIDTNTRYS;
              RWSET1(CIDTCONTRLID  #CURRCIDTPTR#,CIDNATPTR);
              #CIDT$MSEC, LOWBOUND, AND UPRBOUND USED TO BE USED TO#
              #CHECK FOR OVERLAP BETWEEN CONTROL ITEMS AND SOURCE  #
              #AND CONTROL ITEMS.  THIS IS NOW DONE BY THE FUNC    #
              #-OVERLAP- WHICH DOES NOT USE THESE FIELDS.  THUS,   #
              # THESE FIELDS AND POSSIBLY THE WHOLE CIDTABLE CAN   #
              #BE DONE AWAY WITH SOME TIME.                        #
              $TEMP$ = GETQ(DN$SUBMSEC,DNAT$,CIDNATPTR);
              RWSET1(CIDT$MSEC  #CURRCIDTPTR#,$TEMP$);
              $TEMP$ = GETQ(DN$BYTEOFFS,DNAT$,CIDNATPTR); 
              RWSET1(CIDTLOWBOUND  #CURRCIDTPTR#,$TEMP$); 
              $TEMP$ = GETQ(DN$BYTEOFFS,DNAT$,CIDNATPTR) - 1 +
                       GETQ(DN$ITMLEN,DNAT$,CIDNATPTR); 
              RWSET1(CIDTUPRBOUND  #CURRCIDTPTR#,$TEMP$); 
              RWSET1(CIDTCHOCURD  #CURRCIDTPTR#,0); 
              RWSET1(CIDTCFOCURD  #CURRCIDTPTR#,0); 
              #WILL BE USED FOR TYPE CLAUSE RULE 6.41.3.4#
CIDOEND:  
              END 
          ENDCIDTCURRD = CURRCIDTPTR; 
          #COMPARE "ADDRESSES" OF CONTROL-IDENTIFIERS TO DETERMINE IF#
          #THE FOLLOWING RULE IS VIOLATED  (6.19.3)#
          #3.ONE CONTROL ITEM MAY NEITHER BE SUBORDINATE TO NOR AN# 
          #EXPLICIT/IMPLICIT REDEFINITION OF ANOTHER CONTROL ITEM#
          #WITHIN THE SAME REPORT.(IE. - ONE CONTROL ITEM MAY NOT#
          #SHARE STORAGE WITH ANOTHER CONTROL ITEM WITHIN THE SAME# 
          #REPORT.)#
  
          #CIDTPTRCURRD SAYS WHERE FIRST ENTRY FOR THIS#
          #RD IS LOCATED  IN THE CIDTLINK#
  
          CURRCIDTPTR  =  CIDTPTRCURRD; 
          NEXTCIDTPTR  =  RWGET1(CIDTLINK  #CURRCIDTPTR#);
          IF RWGET(CIDTLINK,NEXTCIDTPTR) EQ 0 
          THEN
              GOTO CALCONTROLST;
TESTOVERLAPL: 
          #COMPARE ENTRIES OF CIDTLINK AGAINST ONE ANOTHER# 
  
          FOR $DUMMY$ = 0 WHILE RWGET(CIDTLINK ,NEXTCIDTPTR) NQ 0 DO
              BEGIN 
              IF OVERLAP( RWGET1(CIDTCONTRLID  #CURRCIDTPTR#) , 
                          RWGET (CIDTCONTRLID, NEXTCIDTPTR ))  EQ  0
              THEN
                  GOTO ISOK;
                  #ONLY COMPILER ACTION ON THIS ERROR IS TO ISSUE A#
              #WARNING DIAGNOSTIC#
              #DIAGNOSTIC#
              #CONTROL IDENTIFIER  CIDTCONTRLID   AND#
              #CONTROL IDENTIFIER CIDTCONTRLID  SHARE#
              #STORAGE WITH ONE ANOTHER#
  
              #NEED TO PUT OUT LINE NUMBER AND COLUMN NUMBER OF ANY # 
              # OVERLAPPING   # 
              #CONTROL ID"S  MUST SEARCH RP-AUX TABLE FOR THEM.#
              FOR AUXINDEX = F1CNTRLAUXIN  STEP 1 UNTIL 
                  LCNTRLAUXIND DO 
                  BEGIN 
                  IF
                      RWGET(CONTIDNATPTR,AUXINDEX) EQ 
                      RWGET1(CIDTCONTRLID  #CURRCIDTPTR#) 
                  THEN
                      BEGIN 
                      CURRCILINENO = RWGET(RDLINENUM,AUXINDEX); 
                      CURRCICOLNO = RWGET(RDCOLUMNUM,AUXINDEX); 
                      CALLCDIAG(CURRCILINENO,006,CURRCICOLNO);
                      END 
                  IF
                      RWGET(CONTIDNATPTR,AUXINDEX) EQ 
                      RWGET(CIDTCONTRLID,NEXTCIDTPTR) 
                  THEN
                      BEGIN 
                      NEXTCILINENO  = RWGET(RDLINENUM,AUXINDEX);
                      NEXTCICOLNO  = RWGET(RDCOLUMNUM,AUXINDEX);
                      CALLCDIAG(NEXTCILINENO,007,NEXTCICOLNO);
                      END 
                  END 
              #OF SEARCH OF RP-AUX FOR LINE/COL NUMBERS#
GETTHENEXT: 
ISOK: 
              NEXTCIDTPTR = RWGET(CIDTLINK ,NEXTCIDTPTR); 
              END 
          #END OF TESTOVERLAPL# 
  
          #ABOVE CODE TAKES CARD OF ONLY 1 SET  OF COMPARISONS# 
          #NOW DO SET UP FOR NEXT SET#
  
          CURRCIDTPTR =  RWGET1(CIDTLINK  #CURRCIDTPTR#); 
          NEXTCIDTPTR  =  RWGET1(CIDTLINK  #CURRCIDTPTR#);
          IF RWGET(CIDTLINK ,NEXTCIDTPTR)   NQ 0
          THEN
              GOTO TESTOVERLAPL;
CALCONTROLST: 
          IF NOFDFLAG EQ 0
          THEN
              CTBUILD;
  
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  # * #   EXTRACE("CNTRLCL")                                       # * #
  # * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *#
  
          END #CNTRLCL# 
          TERM
