*DECK DBSLNXRR
USETEXT DBTEXT
PROC NXTRNRD; 
*CALL DEBUGVARS 
XREF BEGIN
PROC IERR$; 
FUNC WA$TO$DNAT;
END 
START("NXTRNRD")
 CONTROL IFNQ CB5$CDCS,"NO";
# 
THIS PROCEDURE PERFORMS THE FOLLOWING FUNCTIONS :-
  B. ACCESSES THE NEXT ATOM OF RENAME/REDEFINE DATA AND 
     UNPACKS IT.
     EACH ATOM APPARENTLY CONTAINS EITHER RENAME OR REDEFINE
     DATA (WITH THE POSSIBILITY OF QUALIFIERS WHICH ARE IGNORED). 
* 
NOTE : DEPENDENT ON WHETHER A * RENAME A THRU B * STRUCTURE 
       IS FOUND, THIS PROCEDURE WILL ACCESS ONE OR TWO ATOMS
       THEREFORE, A SUBROUTINE (GETNXTRNRD) IS USED INTERNALLY
       TO SET LOCAL VARIABLES.
# 
ITEM LRNRD;  #RENAME/RDEF FLAG - NZ = RENAME# 
ITEM LNEXT;  #NEXT ATOM INDICATOR#
ITEM LDNA;    #DATA NAME ADDRESS# 
ITEM LTHRU;   # * THRU * FLAG#
IF SBITMRDRNI[1] THEN LRNRD=1; ELSE LRNRD=0;  #1-RENAME, 0-REDEFINE#
IV$($SET$,"LRNRD",LRNRD)
GETNXTRNRD;  #EXTRACT NEXT ATOM INTO LOCAL VARIABLES# 
IF LRNRD NQ 0 
  THENB ("RENAME ATOM") 
  SETI("ISTRENAM",ISTRENAM,WA$TO$DNAT(LDNA))
                   #SAVE DNAT OF START RENAME#
    LOOP("WHILE SEARCHING FOR LAST QUALIFIER")
    EXITIF(IRNQUAL,EQ,0,"LAST QUALIFIER FOUND") 
       GETNXTRNRD; #LAST QUAL HOLDS THE THRU BIT# 
    ENDLOOP("LAST QUALIFIER FOUND") 
  IF LTHRU NQ 0 
    THENB ("RENAME A THRU B") 
    GETNXTRNRD;              #EXTRACT ATOM FOR OBJECT OF -THRU-#
    SETI("IENRENAM",IENRENAM,WA$TO$DNAT(LDNA))
                   #SAVE DNAT OF END RENAME#
    ELSEB ("SIMPLE RENAME") 
    SETI("IENRENAM",IENRENAM,0)  #RESET END RENAME# 
  ENDIF 
  ELSEB ("REDEFINE ATOM") 
  SETI("ISTRENAM",ISTRENAM,0) #RESET RENAME VALUES# 
  SETI("IENRENAM",IENRENAM,0) 
  IF LTHRU NQ 0 
    THENB ("THRU BIT SHOULD NOT BE SET")
    IERR$(L14,ABORT); 
  ENDIF 
  SETI("IREDEF",IREDEF,WA$TO$DNAT(LDNA)) #SAVE DNAT OF REDEFINED ITEM#
SETO("LDNA",LDNA,0) #ENSURE RESET TO ZERO#
ENDIF 
# 
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 
GETNXTRNRD SUBROUTINE 
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 
# 
PROC GETNXTRNRD;
START("GETNXTRNRD") 
IF RNRDR EQ 0 
  THENB ("ACCESS LEFT ATOM")
  OV$($SET$,"RNRD WORD",SBITMALIASNM[1])
  IF SBITMLRNNXT[1] THEN LNEXT=1; ELSE LNEXT=0; 
  IF SBITMLRNTHRU[1] THEN LTHRU=1; ELSE LTHRU=0;
  SETI("RNRDR",RNRDR,1)      #SET TO EXTRACT RIGHT ATOM NEXT# 
  
  IF IRNQUAL EQ 0 
    THENB ("CURRENT ATOM IS NOT QUALIFIER") 
    IF SBITMLRNQALF[1] THEN IRNQUAL=1; ELSE IRNQUAL=0;
    SETI("LDNA",LDNA,SBITMLRNDNAD[1])  #DATA NAME ADDRESS#
  ENDIF 
  IF SBITMLRNQALF[1] THEN IRNQUAL=1; ELSE IRNQUAL=0;
  ELSEB ("ACCESS RIGHT ATOM") 
  IF SBITMRRNNXT[1] THEN LNEXT=1; ELSE LNEXT=0; 
  IF SBITMRRNTHRU[1] THEN LTHRU=1; ELSE LTHRU=0;
  SETI("RNRDR",RNRDR,0)      #SET TO EXTRACT RIGHT ATOM NEXT# 
  IF IRNQUAL EQ 0 
    THENB ("RIGHT ATOM IS NOT QUALIFIER") 
    IF SBITMRRNQALF[1] THEN IRNQUAL=1; ELSE IRNQUAL=0;
    SETI("LDNA",LDNA,SBITMRRNDNAD[1]) 
  ENDIF 
  IF SBITMRRNQALF[1] THEN IRNQUAL=1; ELSE IRNQUAL=0;
  SETO("P<ITMBA>",P<ITMBA>,P<ITMBA>+1)
  SETO("IRNRDWA",IRNRDWA,IRNRDWA+1) 
  IF P<ITMBA> GQ LOC(ITMA)+ITMASIZE 
    THENB("NEXT WORD NOT IN CORE")
    SETO("P<ITMBA>",P<ITMBA>,LOC(ITMA)+ITMFIXSIZE)
    DA$GTSB(ITMBA,ITMASIZE-ITMFIXSIZE,IRNRDWA); 
    IF DASTATE EQ 1 
      THENB("RN ITEM READ ERROR") 
      IERR$(L9,ABORT);
    ENDIF 
    SETI("IOCCRRFLG",IOCCRRFLG,2) 
  ENDIF 
ENDIF 
FINIS("GETNXTRNRD") 
 CONTROL FI;
FINIS("NXTRNRD")
TERM
